home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
LIBRARY
/
OGRID110
/
GLTSHEET.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1995-06-01
|
173KB
|
5,258 lines
{********************************************************************
OOGrid Library(TM) for Borland/Turbo Pascal (Real Mode/TV)
Copyright (C) 1994, 1995 by Arturo J. Monge
Portions Copyright (C) 1989,1990 Borland International, Inc.
OOGrid Library(TM) Main Unit:
Implementation of a spreadsheet.
Copyright (C) 1994, 1995 by Arturo J. Monge
Last Modification : June 1st, 1995
*********************************************************************}
{$F+,O+,N+,E+,X+,V-}
unit GLTSheet;
{****************************************************************************}
interface
{****************************************************************************}
uses Crt, Dialogs, Dos, Objects, Views, Drivers, TCHash, GLSort, GLParser, GLSupprt,
GLCell, GLViews, GLEquate;
const
{ Constants used by TSpreadSheet's methods }
RedrawYes = True;
RedrawNo = False;
EditYes = True;
EditNo = False;
DisplayYes = True;
DisplayNo = False;
ModifiedYes = True;
ModifiedNo = False;
RemoveBlock = True;
RemoveSingleCell = False;
ChangeYes = True;
ChangeNo = False;
const
{ TSpreadSheet palette }
CSpreadSheet = #12#13#14#15#16#17#18#19#20#21#22#23#24#25#26#27#28#29#30+
#31#32#33#34#35#36;
{ CSpreadSheet palette layout }
{ 1 = Empty Cell }
{ 2 = Value Cell }
{ 3 = Text Cell }
{ 4 = Repeat Cell }
{ 5 = Formula Cell }
{ 6 = Column headers }
{ 7 = Row numbers }
{ 8 = Cell Data Area }
{ 9 = Cell Contents Area }
{ 10 = Spreadsheet Info Area }
{ 11 = Cell In Block }
{ 12 = Cell Highlighted }
{ 13 = Cell Highlighted in Block }
{ 14 = Unlocked Cell }
{ 15 = Unlocked Cell in Block }
{ 16 = Unlocked Cell Highlighted }
{ 17 = Unlocked Cell Highlighted in Block }
{ 18 = Cell Error }
{ 19 = Cell Error in Block }
{ 20 = Cell Error Highlighted }
{ 21 = Cell Error Highlighted in Block }
{ 22 = Unlocked Cell Error }
{ 23 = Unlocked Cell Error in Block }
{ 24 = Unlocked Cell Error Highlighted }
{ 25 = Unlocked Cell Error Highlighted in Block }
const
DisplayEnabled : Boolean = True;
{ Used by TSpreadSheet's SetChanged method. When DisplayEnabled is True,
SetChanged will display the information area of the spreadsheet
to indicate a change in the Modified state. This global constant
was added to be able to store TSpreadSheet objects in a resource
file, without having to insert them in the application first. This
field is always set to False when using the GLTVR_US or GLTVR_SP
units. }
{#X TSpreadSheet.DisplayInfo TSpreadSheet.SetChanged TSpreadSheet.Modified }
type
PColStart = ^ColStartArray;
ColStartArray = array[0..ScreenCols] of Byte;
{ Array used to store the screen positions where displayed columns start }
PSpreadSheet = ^TSpreadSheet;
TSpreadSheet = object(TScroller)
Modified : Boolean;
MaxDecimalPlaces : Byte;
DefaultColWidth : Byte;
DefaultDecimalPlaces : Byte;
DefaultCurrency : CurrencyStr;
MaxRows : Integer;
MaxCols : Integer;
MaxColWidth : Byte;
MaxScreenCols : Byte;
TotalRows : ScreenRowRange;
RowNumberSpace : Byte;
OldCurrPos : CellPos;
CurrPos : CellPos;
LastPos : CellPos;
ScreenBlock : PBlock;
CurrBlock : PBlock;
BlockOn : Boolean;
ColArea : TScreenArea;
RowArea : TScreenArea;
InfoArea : TScreenArea;
DataArea : TScreenArea;
DisplayArea : TScreenArea;
ContentsArea : TScreenArea;
BlankArea : TScreenArea;
NoBlankArea : Boolean;
ColStart : PColStart;
CellHash : TCellHashTable;
WidthHash : TWidthHashTable;
OverwriteHash : TOverwriteHashTable;
FormatHash : TFormatHashTable;
DisplayFormulas : Boolean;
AutoCalc : Boolean;
GoToEnd : Boolean;
KeyPressed : Boolean;
EmptyRowsAtTop : Byte;
EmptyRowsAtBottom : Byte;
SheetProtected : Boolean;
DisplayHeaders : Boolean;
UnlockedHash : TUnlockedHashTable;
ColHeadersHash : THeadersHashTable;
MessageDialog : PDialog;
{ This field is used as a pointer the currently active message
dialog. If no message dialogs are active, TempDialog is set
to nil.
Message dialogs are modeless dialogs, with no buttons, which
only purpose is giving the user a message while TSpreadSheet
is working on a given operation. For example, }
{#F+}
{}
{ 'Updating data tables... please wait.' }
{#F-}
constructor Init(var Bounds: TRect; InitCells: LongInt;
AEmptyRowsAtTop, AEmptyRowsAtBottom: Byte;
AHScrollBar, AVScrollBar: PScrollBar;
AInitMaxCols, AInitMaxRows: Integer;
InitDefaultColWidth,
InitDefaultDecimalPlaces,
InitMaxDecimalPlaces: Byte;
InitDefaultCurrency: CurrencyStr);
function AddCell(CellType: CellTypes; Pos: CellPos; Error: Boolean;
Value: Extended; Input: String): Boolean; virtual;
function CellHashStart(TotalCells: LongInt): BucketRange; virtual;
function CellsProtected(Block: TBlock): Boolean; virtual;
function CellToFString(P: CellPos; var AColor: Byte): String; virtual;
procedure ChangeBounds(var Bounds: TRect); virtual;
procedure ChangeColHeaders; virtual;
procedure ChangeColWidth; virtual;
procedure ChangeHeader(Block: PBlock; AColumn: Word; NewHeader: String);
virtual;
{ Changes the header of a column or block of columns.
The Block and AColumn parameters are mutually exclusive. If Block
is not nil, the AColumn parameter will be ignored; otherwise, the
Block parameter is ignored and the AColumn parameter is used instead.
Use Block if you want to change the header of a block of
columns. Use AColumn if you want to change the header of a single
column. }
procedure ChangeWidth(Block: PBlock; AColumn: Word; NewWidth: Byte);
virtual;
{ Changes the width of a column or block of columns.
The Block and AColumn parameters are mutually exclusive. If Block
is not nil, the AColumn parameter will be ignored; otherwise, the
Block parameter is ignored and the AColumn parameter is used instead.
Use Block if you want to change the width of a block of
columns. Use AColumn if you want to change the width of a single
column. }
procedure CheckForDragging; virtual;
procedure ClearCurrBlock; virtual;
procedure ClearScreenArea(AreaToClear: PScreenArea); virtual;
function ColHeadersHashStart : BucketRange; virtual;
function ColumnToString(Column: Word): String; virtual;
function ColToX(Col: Integer): Byte; virtual;
function ColWidth(Col: Integer): Byte; virtual;
procedure CopyCellBlock; virtual;
procedure DeleteBlock(Block: TBlock; var Deleted: Boolean); virtual;
procedure DeleteCell(Pos: CellPos; var Deleted: Boolean); virtual;
procedure DeleteColFromHash(Block: TBlock; Columns, EndDelCol: Word);
virtual;
procedure DeleteColHeaders(Block: PBlock); virtual;
procedure DeleteColumns; virtual;
procedure DeleteRowFromHash(Block: TBlock; Rows, EndDelRow: Word);
virtual;
procedure DeleteRows; virtual;
procedure DisplayAllCells; virtual;
procedure DisplayBlock(B: TBlock); virtual;
procedure DisplayBlockDiff(B1, B2: TBlock); virtual;
procedure DisplayCell(P: CellPos); virtual;
procedure DisplayCellBlock(C1, R1, C2, R2: Word); virtual;
procedure DisplayCellData; virtual;
procedure DisplayCols; virtual;
procedure DisplayInfo; virtual;
procedure DisplayRows; virtual;
procedure DoAfterAddingCell; virtual;
function DoBeforeAddingCell: Boolean; virtual;
{ This function is called immediatly after an input string has been
parsed in the #HandleInput# method, and before actually adding the
corresponding cell. If DoBeforeAddingCell returns TRUE the cell is
added; if it returns FALSE, the cell won't be added and the user
will be returned to the input line.
If there is an error in the input string, this function will not
be called.
You should override this function if you want, for example, to
validate the data that is entered in each column. If the data
entered by the user cannot be added to the current column,
DoBeforeAddingCell can display an error message and return false.
By default, DoBeforeAddingCell returns true. }
procedure DragCursorWithMouse(Event: TEvent); virtual;
procedure Draw; virtual;
procedure EraseCellBlock(EraseBlock: Boolean); virtual;
procedure ExtendCurrBlock(Redraw : Boolean); virtual;
procedure FindLastPos(DPos: CellPos); virtual;
procedure FindScreenColStart; virtual;
procedure FindScreenColStop; virtual;
procedure FindScreenRowStart; virtual;
procedure FindScreenRowStop; virtual;
procedure FixBlockOverWrite(Block: TBlock); virtual;
function FixOverWrite: Boolean; virtual;
procedure FormatDefault; virtual;
function FStringSituationColor(P: CellPos; var CP: PCell;
var HasError, ColorFound: Boolean): Byte; virtual;
procedure FormatCells; virtual;
function GetNumber: Integer;
{ Returns the number of the window that owns the object }
function GetPalette: PPalette; virtual;
procedure GoToCell; virtual;
procedure GoToPos(Pos: CellPos); virtual;
{ Moves the cursor to the given position and redraws the screen if
necessary. }
procedure HandleEvent(var Event: TEvent); virtual;
procedure HandleInput(FirstChar: String; Editing: Boolean); virtual;
procedure InitCurrPos; virtual;
procedure InsertColToHash(Block: TBlock; Columns, StartInsCol: Word);
virtual;
procedure InsertColumns; virtual;
procedure InsertRowToHash(Block: TBlock; Rows, StartInsRow: Word);
virtual;
procedure InsertRows; virtual;
constructor Load(var S: TStream);
procedure LoadDelimited(FileName: PathStr); virtual;
{ This method imports a comma delimited file of a certain format and
is intended only as an example of how to import comma delimited files.
This method must be overridden if you wish to import delimited files
of different formats }
procedure LoadHashTables(var S: TStream; AdjustAfter: CellPos;
RowAdjustment, ColAdjustment: Integer); virtual;
procedure LoadTablesFromTempFile(AdjustAfter: CellPos;
RowAdjustment, ColAdjustment: Integer); virtual;
procedure LocateCursorWithMouse(Event: TEvent); virtual;
procedure MoveCell(OldPos: CellPos); virtual;
procedure MoveCellBlock; virtual;
procedure MoveDown; virtual;
procedure MoveHome; virtual;
procedure MoveLeft; virtual;
procedure MovePgDown; virtual;
procedure MovePgLeft; virtual;
procedure MovePgRight; virtual;
procedure MovePgUp; virtual;
procedure MoveRight; virtual;
procedure MoveUp; virtual;
function OverwriteHashStart: BucketRange; virtual;
function Parser: PParserObject; virtual;
procedure PasteBlock(DestBlock: TBlock; Formulas: Word); virtual;
procedure PasteCellBlock; virtual;
procedure Print; virtual;
procedure Recalc(Display: Boolean); virtual;
function RowToY(Row: Integer): Byte; virtual;
function SameCellPos(P1, P2 : CellPos) : Boolean; virtual;
procedure ScrollDraw; virtual;
function SelectColumn(var Event: TEvent): Boolean; virtual;
procedure SetAreas(ScrollArea: TRect); virtual;
procedure SetAvailableCommands; virtual;
{ Enables all commands handled by TSpreadSheet. Some commands
may not be enabled if the spreadsheet is protected. }
{#X SheetProtected }
procedure SetBlankArea; virtual;
procedure SetChanged(IsChanged: Boolean); virtual;
procedure SetFormat(Block: TBlock; DecimalPlaces: Byte; Justification,
NumberFormat: Word; CurrencyChar: Char); virtual;
{ Formats a block of cells using the given format information.
Possible values of the Justification parameter and their meanings:}
{#F+}
{}
{ Value │ Meaning }
{ ═══════╪════════════════════════ }
{ 0 │ Left justification }
{ 1 │ Center justification }
{ 2 │ Right justification }
{#F-}
{ Possible values of the NumberFormat parameter and their meainigs:}
{#F+}
{}
{ Value │ Meaning }
{ ═══════╪════════════════════════════════════════════════ }
{ 0 │ Do not format numbers }
{ 1 │ Add a currency character to numbers }
{ 2 │ Add commas to numbers }
{ 3 │ Add commans and a currency character to numbers }
{#F-}
procedure SetLimit(X, Y: Integer); virtual;
procedure SetLocked; virtual;
procedure SetNameWithMouse(var Event: TEvent); virtual;
procedure SetProtection(Enable, Display: Boolean); virtual;
procedure SetScreenColStart(NewCol: Integer); virtual;
procedure SetScreenColStop(NewCol: Integer); virtual;
procedure SetScreenRowStart(NewRow: Integer); virtual;
procedure SetScreenRowStop(NewRow: Integer); virtual;
procedure SetState(AState: Word; Enable: Boolean); virtual;
procedure SetUnlocked; virtual;
procedure SortData; virtual;
function SortObject : PSortObject; virtual;
procedure Store(var S: TStream);
procedure StoreHashTables(var S: TStream); virtual;
procedure StoreTablesToTempFile; virtual;
procedure ToggleAutoCalc; virtual;
procedure ToggleBlockOn; virtual;
procedure ToggleDisplayHeaders; virtual;
procedure ToggleEnd; virtual;
procedure ToggleFormulaDisplay; virtual;
function TrackCursor: Boolean; virtual;
procedure UpdateScreenBlockDisplay; virtual;
function WidthHashStart:BucketRange; virtual;
function XToCol(X: Byte): Integer; virtual;
function YToRow(Y: Byte): Integer; virtual;
procedure DoneHashTables; virtual;
destructor Done; virtual;
end; {...TSpreadSheet }
type
BlockOperation = (opCopy, opMove);
{ Used by the clipboard record to indicate what kind of operation
was requested }
ClipBoardRecord = RECORD
{ This record is used to store information necessary for copy and move
operations }
Active : Boolean;
SourceSpreadSheet : PSpreadSheet;
SourceCellHash : PCellHashTable;
BlockToCopy : PBlock;
CopyBlock : Boolean;
Operation : BlockOperation;
end; {...ClipBoardRecord }
var
Clipboard : ClipBoardRecord;
procedure RegisterSpreadSheet;
{ Register all the units in OOGrid Library(TM) v1.0 }
procedure RegisterGLTSheet;
{ Register this unit's objects }
const
RSpreadSheet : TStreamRec = (
ObjType : stRSpreadSheet;
VmtLink : Ofs(TypeOf(TSpreadSheet)^);
Load : @TSpreadSheet.Load;
Store : @TSpreadSheet.Store
);
{****************************************************************************}
implementation
{****************************************************************************}
uses App, Memory, TCUtil, MsgBox, StdDlg, GLWindow;
const
OOGridFileHeader = 'OOGridLv1.00';
{ All TSpreadSheet objects stored in a stream will be identified by
this file header.
Version 1.00 refers to the stream version, not to the library's
version (i.e. it refers to the version of the load and store
methods). }
{****************************************************************************}
{** Clipboard variables, procedures and functions **}
{****************************************************************************}
procedure InitClipBoard;
{ Resets the ClipBoard fields }
begin
with ClipBoard do
begin
Active := False;
SourceSpreadSheet := nil;
SourceCellHash := nil;
if BlockToCopy <> nil then
begin
Dispose(BlockToCopy);
BlockToCopy := nil;
end; {...if BlockToCopy <> nil }
Operation := opCopy;
CopyBlock := False;
end; {...with ClipBoard }
end; {...InitClipBoard }
procedure ToggleClipBoardOn(SpreadSheet: PSpreadSheet; Block: PBlock;
ABlockOn: Boolean; Op: BlockOperation);
{ Sets the Clipboard fields for a copy or move operation }
begin
with Clipboard do
begin
Active := True;
SourceSpreadSheet := SpreadSheet;
SourceCellHash := @SpreadSheet^.CellHash;
BlockToCopy := Block;
CopyBlock := ABlockOn;
Operation := Op;
end; {...with ClipBoard }
if Op = opCopy then
begin
if not DisplayMessage(GLStringList^.Get(sCopyCellsMsg)) then
begin
Application^.OutOfMemory;
InitClipBoard;
end; {...if not DisplayMessage(GLStringList^.Get(sCopyCellsMsg)) }
end {...if Op = opCopy }
else
begin
if not DisplayMessage(GLStringList^.Get(sMoveCellsMsg)) then
begin
Application^.OutOfMemory;
InitClipBoard;
end; {...if not DisplayMessage(GLStringList^.Get(sMoveCellsMsg)) }
end; {...if/else }
end; {...ToggleClipBoardOn }
procedure ToggleClipBoardOff;
{ Clears the ClipBoard }
begin
InitClipBoard;
EraseMessage;
end; {...ToggleClipBoardOff }
{****************************************************************************}
{** GetColWidth function **}
{****************************************************************************}
function GetColWidth(var WHash : TWidthHashTable; C : Word) : Byte;
{ Gets the width of a column }
var
W : Word;
begin
W := WHash.Search(C);
if W = 0 then
GetColWidth := WHash.GetDefaultColWidth
else
GetColWidth := W;
end; {...GetColWidth }
{****************************************************************************}
{** Unit's Register procedures **}
{****************************************************************************}
procedure RegisterSpreadSheet;
{ Register all streamable objects of the spreadsheet }
begin
RegisterGLTSheet;
RegisterGLSupprt;
RegisterGLCell;
RegisterGLViews;
end; {...RegisterSpreadSheet }
procedure RegisterGLTSheet;
begin
RegisterType(RSpreadSheet);
end; {...RegisterGLTSheet }
{****************************************************************************}
{** TSpreadSheet Object **}
{****************************************************************************}
constructor TSpreadSheet.Init(var Bounds: TRect;
InitCells: LongInt; AEmptyRowsAtTop, AEmptyRowsAtBottom: Byte;
AHScrollBar, AVScrollBar: PScrollBar; AInitMaxCols,
AInitMaxRows: Integer; InitDefaultColWidth, InitDefaultDecimalPlaces,
InitMaxDecimalPlaces: Byte; InitDefaultCurrency: CurrencyStr);
const
MinRowsToDisplay = 2;
var
CellPosition : CellPos;
R : TRect;
begin
if not TScroller.Init(Bounds, AHScrollBar, AVScrollBar) then
Fail;
Delta.X := 1;
Delta.Y := 1;
EventMask := evMouseDown + evKeyDown + evCommand + evBroadCast;
Options := Options and not ofBuffered;
GrowMode := gfGrowHiX + gfGrowHiY;
if HScrollBar <> nil then
begin
HScrollBar^.EventMask := HScrollBar^.EventMask and not evKeyDown;
with PLimScrollBar(HScrollBar)^ do
begin
DisplayLimit := TCUtil.Min(DisplayLimit, AInitMaxCols);
end; { with }
end; { if }
if VScrollBar <> nil then
begin
VScrollBar^.EventMask := VScrollBar^.EventMask and not evKeyDown;
with PLimScrollBar(VScrollBar)^ do
begin
DisplayLimit := TCUtil.Min(DisplayLimit, AInitMaxRows);
end; { with }
end; { if }
if not CellHash.Init(CellHashStart(InitCells)) then
Fail;
if not WidthHash.Init(WidthHashStart, InitDefaultColWidth) then
begin
CellHash.Done;
Fail;
end; {...if not WidthHash.Init }
if not OverwriteHash.Init(OverwriteHashStart) then
begin
CellHash.Done;
WidthHash.Done;
Fail;
end; {...if not OverWriteHash.Init }
if not FormatHash.Init then
begin
CellHash.Done;
WidthHash.Done;
OverwriteHash.Done;
Fail;
end; {...if not FormatHash.Init }
if not ColHeadersHash.Init(ColHeadersHashStart) then
begin
CellHash.Done;
WidthHash.Done;
OverWriteHash.Done;
FormatHash.Done;
Fail;
end; {...if not ColHeadersHash.Init }
if not UnlockedHash.Init then
begin
CellHash.Done;
WidthHash.Done;
OverWriteHash.Done;
FormatHash.Done;
ColHeadersHash.Done;
Fail;
end; {...if not UnlockedHash.Init }
EmptyRowsAtTop := AEmptyRowsAtTop;
EmptyRowsAtBottom := AEmptyRowsAtBottom;
RowNumberSpace := 6;
MaxColWidth := Succ(ScreenCols - RowNumberSpace);
MaxScreenCols := MaxColWidth div DefaultMinColWidth;
GetMem(ColStart, MaxScreenCols);
if ColStart = nil then
begin
CellHash.Done;
WidthHash.Done;
OverWriteHash.Done;
FormatHash.Done;
ColHeadersHash.Done;
UnlockedHash.Done;
Fail;
end; {...if ColStart = nil }
InitCurrPos;
OldCurrPos := CurrPos;
LastPos := CurrPos;
BlockOn := False;
AutoCalc := False;
DisplayFormulas := False;
GoToEnd := False;
ScreenBlock := New(PBlock, Init(CurrPos));
CurrBlock := New(PBlock, Init(CurrPos));
DefaultColWidth := InitDefaultColWidth;
DefaultDecimalPlaces := InitDefaultDecimalPlaces;
DefaultCurrency := InitDefaultCurrency;
MaxDecimalPlaces := InitMaxDecimalPlaces;
MaxCols := AInitMaxCols;
MaxRows := AInitMaxRows;
GetExtent(R);
Inc(R.A.Y, EmptyRowsAtTop);
Dec(R.B.Y, EmptyRowsAtBottom);
SetAreas(R);
SetLimit(MaxCols, MaxRows);
DisplayHeaders := True;
SetProtection(False, False);
SetAvailableCommands;
MessageDialog := nil;
end; {...TSpreadSheet.Init }
function TSpreadSheet.AddCell(CellType: CellTypes; Pos: CellPos;
Error: Boolean; Value: Extended; Input: String): Boolean;
{ Adds a cell to the cell hash }
var
OldLastPos : CellPos;
CellPtr, CP : PCell;
begin
AddCell := False;
case CellType of
ClValue : CellPtr := New(PValueCell, Init(Pos, Error, Value));
ClFormula : CellPtr := New(PFormulaCell, Init(Pos, Error, Value, Input));
ClText : CellPtr := New(PTextCell, Init(Pos, Input));
ClRepeat : CellPtr := New(PRepeatCell, Init(Pos, Input[2]));
end; {...case CellType }
if CellPtr = nil then
Exit;
if not CellHash.Add(CellPtr) then
begin
Dispose(CellPtr, Done);
Exit;
end; {...if not CellHash.Add(CellPtr) }
OldLastPos := LastPos;
FindLastPos(Pos);
if not OverWriteHash.Add(CellPtr, CellHash, FormatHash, WidthHash, LastPos,
MaxCols, GetColWidth, DisplayFormulas, ChangeYes) then
begin
LastPos := OldLastPos;
CellHash.Delete(CellPtr^.Loc, CP);
Dispose(CellPtr, Done);
Exit;
end; {...if not OverWriteHash.Add }
AddCell := True;
end; {...TSpreadSheet.AddCell }
function TSpreadSheet.CellHashStart(TotalCells: LongInt): BucketRange;
{ Returns the initial number of buckets for the Cell hash table }
begin
CellHashStart := Max(100, Min(MaxBuckets, TotalCells div 10));
end; {...TSpreadSheet.CellHashStart}
function TSpreadSheet.CellsProtected(Block: TBlock): Boolean;
var
P : CellPos;
begin
CellsProtected := False;
if SheetProtected then
begin
for P.Row := Block.Start.Row to Block.Stop.Row do
for P.Col := Block.Start.Col to Block.Stop.Col do
if not UnlockedHash.Search(P) then
begin
CellsProtected := True;
Exit;
end; {...if not UnlockedHash.Search(P) }
end; {...if SheetProtected }
end; {...TSpreadSheet.CellsProtected }
function TSpreadSheet.CellToFString(P: CellPos; var AColor: Byte): String;
{ Returns the formatted contents of a cell to be displayed in the screen }
var
ColorFound, HasError : Boolean;
S1 : CurrencyStr;
F : FormatType;
CP : PCell;
S : String;
ClType : CellTypes;
begin
AColor := FStringSituationColor(P, CP, HasError, ColorFound);
if HasError and not (DisplayFormulas and (CP^.CellType = ClFormula)) then
begin
S := GLStringList^.Get(sCellError);
S1 := '';
F := Ord(JCenter) shl JustShift;
end {...if HasError and ... }
else
begin
S := CP^.FormattedString(OverwriteHash, FormatHash, WidthHash,
GetColWidth, P, DisplayFormulas, 1, ColWidth(P.Col), S1, ClType);
if not ColorFound then
case ClType of
ClEmpty : AColor := GetColor(1);
ClText : AColor := GetColor(3);
ClValue : AColor := GetColor(2);
ClFormula : if DisplayFormulas then
AColor := GetColor(5)
else
AColor := GetColor(2);
ClRepeat : AColor := GetColor(4);
end; {...case ClType }
F := CP^.Format(FormatHash, DisplayFormulas);
end; {...if/else }
if (Length(S1) + Length(S)) <= ColWidth(P.Col) then
case Justification((F shr JustShift) and JustPart) of
JLeft : CellToFString := S1 + LeftJustStr(S, ColWidth(P.Col) -
Length(S1));
JCenter : CellToFString := S1 + CenterStr(S, ColWidth(P.Col) -
Length(S1));
JRight : CellToFString := S1 + RightJustStr(S, ColWidth(P.Col) -
Length(S1));
end {...case Justification((F shr JustShift) and JustPart) }
else
CellToFString := Copy(S1 + S, 1, ColWidth(P.Col));
end; {...TSpreadSheet.CellToFString }
procedure TSpreadSheet.ChangeBounds(var Bounds: TRect);
{ Changes the size of the spreadsheet and resets the limits of the scroller }
begin
TScroller.ChangeBounds(Bounds);
SetLimit(MaxCols, MaxRows);
end; {...TSpreadSheet.ChangeBounds }
{****************************************************************************}
{ TSpreadSheet.ChangeColHeaders }
{****************************************************************************}
procedure TSpreadSheet.ChangeColHeaders;
{ Changes the header of a column or group of columns }
var
Cancel, HeaderEntered : Boolean;
Dialog : PDialog;
CellPtr : PCell;
Column : Word;
procedure GetValidHeader;
{ Returns WidthEntered as true if a valid width was entered }
var
Code : Integer;
begin
if Desktop^.ExecView(Dialog) <> cmCancel then
begin
Dialog^.GetData(RChangeHeader);
HeaderEntered := True;
end {...if Desktop^.ExecView(Dialog) <> cmCancel }
else
Cancel := True;
end; {...GetValidHeader }
begin
Cancel := False;
HeaderEntered := False;
Dialog := PDialog(GLResFile^.Get('ChangeHeaderDialog'));
if not BlockOn or (BlockOn and (CurrBlock^.Start.Col = CurrBlock^.Stop.Col)) then
begin
if not ColHeadersHash.Search(CurrPos.Col, RChangeHeader.NewHeader) then
RChangeHeader.NewHeader := GLStringList^.Get(sColumnEntryIndicator) +
' '+ColumnToString(CurrPos.Col)
end {...if not BlockOn or ... }
else
RChangeHeader.NewHeader := '';
Dialog^.SetData(RChangeHeader);
repeat
if (Application^.ValidView(Dialog) <> nil) then
GetValidHeader
else
Exit;
until HeaderEntered or Cancel;
if not Cancel then
begin
with RChangeHeader do
begin
if Copy(NewHeader, 1, Length(GLStringList^.Get(sColumnEntryIndicator)))
= GLStringList^.Get(sColumnEntryIndicator) then
NewHeader := Copy(NewHeader, Length(GLStringList^.
Get(sColumnEntryIndicator))+2, Length(NewHeader) -
Length(GLStringList^.Get(sColumnEntryIndicator))+1);
if not BlockOn then
begin
CurrBlock^.Start := CurrPos;
CurrBlock^.Stop := CurrPos;
end; { if }
ChangeHeader(CurrBlock, 0, NewHeader);
SetChanged(ModifiedYes);
end; { with }
DrawView;
end; {...if not Cancel }
Dispose(Dialog, Done);
end; {...TSpreadSheet.ChangeColHeaders }
{****************************************************************************}
{ TSpreadSheet.ChangeColWidth }
{****************************************************************************}
procedure TSpreadSheet.ChangeColWidth;
{ Changes the width of a column or group of columns }
var
Cancel, WidthEntered : Boolean;
NewWidth : Byte;
Dialog : PDialog;
CellPtr : PCell;
CurrWidth : String[10];
CellsOverWritten : Word;
procedure GetValidWidth(Dialog: PDialog; var Cancel,
WidthEntered: Boolean; var NewWidth: Byte);
{ Returns WidthEntered as true if a valid width was entered }
var
Code : Integer;
begin
if Desktop^.ExecView(Dialog) <> cmCancel then
begin
Dialog^.GetData(RChangeWidth);
Val(RChangeWidth.NewWidth, NewWidth, Code);
if not ((NewWidth >= DefaultMinColWidth) and
(NewWidth <= MaxColWidth) or (NewWidth = 0)) then
MessageBox(GLStringList^.Get(sInvalidWidthMsg), nil, mfError +
mfOKButton)
else
begin
WidthEntered := True;
if NewWidth = 0 then NewWidth := DefaultColWidth;
end; {...if/else }
end {...if Desktop^.ExecView(Dialog) <> cmCancel }
else
Cancel := True;
end; {...GetValidWidth }
begin
Cancel := False;
WidthEntered := False;
Dialog := PDialog(GLResFile^.Get('GetWidthDialog'));
if (not BlockOn) or (BlockOn and
(CurrBlock^.Start.Col = CurrBlock^.Stop.Col)) then
Str(ColWidth(CurrPos.Col), CurrWidth)
else
Str(DefaultColWidth, CurrWidth);
Dialog^.SetData(CurrWidth);
repeat
if (Application^.ValidView(Dialog) <> nil) then
GetValidWidth(Dialog, Cancel, WidthEntered, NewWidth)
else
Exit;
until WidthEntered or Cancel;
if not Cancel then
begin
if not BlockOn then
begin
CurrBlock^.Start := CurrPos;
CurrBlock^.Stop := CurrPos;
end; { if }
ChangeWidth(CurrBlock, 0, NewWidth);
SetChanged(ModifiedYes);
SetScreenColStart(ScreenBlock^.Start.Col);
if CurrPos.Col > ScreenBlock^.Stop.Col then
HScrollBar^.SetValue(CurrPos.Col);
DrawView;
end; {...if not Cancel }
Dispose(Dialog, Done);
end; {...TSpreadSheet.ChangeColWidth }
{****************************************************************************}
{ TSpreadSheet.ChangeHeader }
{****************************************************************************}
procedure TSpreadSheet.ChangeHeader(Block: PBlock; AColumn: Word; NewHeader:
String);
var
Column : Word;
Pos: CellPos;
SingleCol: Boolean;
begin
if Block = nil then
begin
Pos.Col := AColumn;
Pos.Row := 0;
Block := New(PBlock, Init(Pos));
SingleCol := True;
end { if }
else
SingleCol := False;
with ColHeadersHash, Block^ do
begin
for Column := Start.Col to Stop.Col do
begin
if NewHeader <> ColToString(Column) then
begin
Delete(Column);
if (NewHeader <> '') then
begin
if not Add(Column, NewHeader) then
Exit;
end; {...if NewHeader <> '' }
end; {...if NewHeader <> ColToString(Column) }
Delete(Column);
if (NewHeader <> '') and (NewHeader <> ColToString(Column)) then
begin
if not Add(Column, NewHeader) then
Exit;
end; {...if (NewHeader <> '') and ... }
end; {...for Column }
end; {...with ColHeadersHash, CurrBlock^ }
if SingleCol then
Dispose(Block, Done);
end;
{****************************************************************************}
{ TSpreadSheet.ChangeWidth }
{****************************************************************************}
procedure TSpreadSheet.ChangeWidth(Block: PBlock; AColumn: Word; NewWidth:
Byte);
var
Column : Word;
Pos: CellPos;
SingleCol: Boolean;
begin
if Block = nil then
begin
Pos.Col := AColumn;
Pos.Row := 0;
Block := New(PBlock, Init(Pos));
SingleCol := True;
end { if }
else
SingleCol := False;
with WidthHash, Block^ do
begin
for Column := Start.Col to Stop.Col do
begin
Delete(Column);
if NewWidth <> DefaultColWidth then
begin
if not Add(Column, NewWidth) then
Exit;
end; {...if NewWidth <> DefaultColWidth }
end; {...for Column }
end; { with }
with OverWriteHash do
begin
Done;
Init(OverWriteHashStart);
end; {with OverWriteHash }
FixOverWrite;
if SingleCol then
Dispose(Block, Done);
end;
procedure TSpreadSheet.CheckForDragging;
var
ShiftState : Byte absolute $40:$17;
begin
if (ShiftState and (kbRightShift + kbLeftShift)) <> 0 then
begin
if not BlockOn then
ToggleBlockOn;
end {...if ShiftState and (kbRightShift + kbLeftShift) }
else
ClearCurrBlock;
end; {...TSpreadSheet.CheckForDragging }
procedure TSpreadSheet.ClearCurrBlock;
{ Turns off the block mode and redisplays the affected cells }
begin
if BlockOn then
begin
BlockOn := False;
DisplayBlock(CurrBlock^);
end; {...if BlockOn }
DisplayInfo;
end; {...TSpreadSheet.ClearCurrBlock }
procedure TSpreadSheet.ClearScreenArea(AreaToClear: PScreenArea);
{ Clears a given area of the screen }
var
W, H : Byte;
B : TDrawBuffer;
begin
with AreaToClear^ do
begin
W := Succ(LowerRight.Col - UpperLeft.Col);
H := Succ(LowerRight.Row - UpperLeft.Row);
MoveChar(B, ' ', Attrib, W);
WriteLine(UpperLeft.Col, UpperLeft.Row, W, H, B);
end; {...with AreaToClear^ }
end; {...TSpreadSheet.ClearScreenArea }
function TSpreadSheet.ColHeadersHashStart: BucketRange;
{ Returns the initial number of buckets for the Column Names hash table }
begin
ColHeadersHashStart := 10;
end; {...TSpreadSheet.ColHeadersHashStart }
function TSpreadSheet.ColumnToString(Column: Word): String;
{ Converts a column to a string }
var
HasName : Boolean;
S : String[4];
Name : String;
W : Word;
begin
HasName := ColHeadersHash.Search(Column, Name);
if DisplayHeaders and HasName then
ColumnToString := Name
else
begin
if Column > 18278 then { Column is 4 letters }
S := Chr(Ord('A') + ((Column - 18279) div 17576))
else
S := '';
if Column > 702 then { Column is at least 3 letters }
S := S + Chr(Ord('A') + (((Column - 703) mod 17576) div 676));
if Column > 26 then { Column is at least 2 letters }
S := S + Chr(Ord('A') + (((Column - 27) mod 676) div 26));
S := S + Chr(Ord('A') + (Pred(Column) mod 26));
ColumnToString := S;
end; {...if/else }
end; {...TSpreadSheet.ColumnToString }
function TSpreadsheet.ColToX(Col : Integer): Byte;
{ Returns the screen position of a given column }
begin
ColToX := ColStart^[Col - ScreenBlock^.Start.Col];
end; {...TSpreadSheet.ColToX }
function TSpreadSheet.ColWidth(Col: Integer): Byte;
{ Returns the width of a certain column }
var
Width : Integer;
begin
Width := WidthHash.Search(Col);
if Width = 0 then
ColWidth := DefaultColWidth
else
ColWidth := Width;
end; {...TSpreadSheet.ColWidth }
procedure TSpreadSheet.CopyCellBlock;
{ Activates the clipboard and sets it to indicate the block to be copied }
var
Block : PBlock;
begin
if BlockOn then
begin
New(Block, Init(CurrBlock^.Start));
if Block = nil then
Exit;
Block^.Stop := CurrBlock^.Stop;
end {...if BlockOn }
else
begin
New(Block, Init(CurrPos));
if Block = nil then
Exit;
Block^.Stop := CurrPos;
end; {...if/else }
ToggleClipBoardOn(@Self, Block, BlockOn, opCopy);
end; {...TSpreadSheet.CopyCellBlock }
procedure TSpreadSheet.DeleteBlock(Block: TBlock; var Deleted: Boolean);
{ Deletes a block of cells }
var
H, D : HashItemPtr;
CellPtr : PCell;
Counter : Word;
begin
Deleted := False;
with CellHash, Block do
begin
for Counter := 1 to Buckets do
begin
H := HashData^[Counter];
while H <> nil do
begin
D := H;
H := H^.Next;
Move(D^.Data, CellPtr, Sizeof(CellPtr));
with CellPtr^ do
begin
if CellInBlock(Loc) then
DeleteCell(Loc, Deleted);
end; {...with CellPtr^ }
end; {...while H <> nil }
end; {...for Counter }
end; {...with CellHash, Block }
end; {...TSpreadSheet.DeleteBlock }
procedure TSpreadSheet.DeleteCell(Pos: CellPos; var Deleted: Boolean);
{ Deletes a single cell }
var
CellPtr : PCell;
begin
CellHash.Delete(Pos, CellPtr);
if CellPtr <> nil then
begin
OverWriteHash.Delete(Pos, CellHash, FormatHash, WidthHash, LastPos,
MaxCols, GetColWidth, DisplayFormulas, ChangeYes);
Dispose(CellPtr, Done);
Deleted := True;
end {...if CellPtr <> nil }
else
Deleted := False;
end; {...TSpreadSheet.DeleteCell}
procedure TSpreadSheet.DeleteColFromHash(Block: TBlock; Columns, EndDelCol:
Word);
{ Deletes a column or block of columns from the hash tables }
var
Pos, Start, Stop : CellPos;
H : HashItemPtr;
CellPtr : PCell;
Col : Word;
F : File;
Deleted : Boolean;
const
CopyFormulasLiteral = $03;
begin
SetChanged(ModifiedYes);
DeleteBlock(Block, Deleted);
with CellHash do
begin
CellPtr := FirstItem;
while CellPtr <> nil do
begin
with CellPtr^ do
begin
if CellPtr^.ShouldUpdate then
FixFormulaCol(CellPtr, opDelete, EndDelCol, Columns, MaxCols,
MaxRows);
end; {...with CellPtr^ }
CellPtr := NextItem;
end; {...while CellPtr <> nil }
end; {...with CellHash }
for Col := Block.Start.Col to Block.Stop.Col do
WidthHash.Delete(Col);
with WidthHash do
begin
H := FirstItem;
while H <> nil do
begin
if WordPTr(@H^.Data)^ > EndDelCol then
Dec(WordPtr(@H^.Data)^, Columns);
H := NextItem;
end; {...with H <> nil }
end; {...with WidthHash }
Stop.Col := Block.Stop.Col;
Stop.Row := MaxInt;
FormatHash.Delete(Block.Start, Stop);
with FormatHash do
begin
H := FirstItem;
while H <> nil do
begin
Move(H^.Data, Start, SizeOf(Start));
Move(H^.Data[SizeOf(CellPos)], Stop, SizeOf(Stop));
if (Start.Col > (EndDelCol - Columns)) and (Stop.Col <= EndDelCol) then
Delete(Start, Stop)
else
begin
if Start.Col > EndDelCol then
begin
Dec(Start.Col, Columns);
Move(Start, H^.Data, Sizeof(Start));
end; {...if Start.Col > EndDelCol }
if Stop.Col > EndDelCol then
begin
Dec(Stop.Col, Columns);
Move(Stop, H^.Data[Sizeof(CellPos)], Sizeof(Stop));
end; {...if Stop.Col > EndDelCol }
end; {...if/else }
H := NextItem;
end; {...while H <> nil }
end; {...with FormatHash }
DeleteColHeaders(@Block);
with ColHeadersHash do
begin
H := FirstItem;
while H <> nil do
begin
if WordPTr(@H^.Data)^ > EndDelCol then
Dec(WordPtr(@H^.Data)^, Columns);
H := NextItem;
end; {...with H <> nil }
end; {...with ColHeadersHash }
Stop.Col := Block.Stop.Col;
Stop.Row := MaxInt;
UnlockedHash.Delete(Block.Start, Stop);
with UnlockedHash do
begin
H := FirstItem;
while (H <> nil) do
begin
Move(H^.Data, Start, SizeOf(Start));
Move(H^.Data[SizeOf(CellPos)], Stop, SizeOf(Stop));
if (Start.Col > (EndDelCol - Columns)) and (Stop.Col <= EndDelCol) then
Delete(Start, Stop)
else
begin
if Start.Col > EndDelCol then
begin
Dec(Start.Col, Columns);
Move(Start, H^.Data, Sizeof(Start));
end; {...if Start.Col > EndDelCol }
if Stop.Col > EndDelCol then
begin
Dec(Stop.Col, Columns);
Move(Stop, H^.Data[Sizeof(CellPos)], Sizeof(Stop));
end; {...if Stop.Col > EndDelCol }
end; {...if/else }
H := NextItem;
end; {...while H <> nil }
end; {...with UnlockedHash }
StoreTablesToTempFile;
DoneHashTables;
Pos.Col := Succ(EndDelCol);
Pos.Row := 0;
LoadTablesFromTempFile(Pos, 0, -Columns);
Assign(F, GLStringList^.Get(sTempFileName));
Erase(F);
if LastPos.Col > 1 then
Dec(LastPos.Col, Columns);
Pos.Col := EndDelCol - Columns;
if Deleted then
Pos.Row := LastPos.Row
else
Pos.Row := 1;
FindLastPos(Pos);
FixOverWrite;
end; {...TSpreadSheet.DeleteColFromHash }
procedure TSpreadSheet.DeleteColHeaders(Block: PBlock);
{ Deletes from the column headers hash table the headers of the selected
columns }
var
C : Word;
begin
SetChanged(ModifiedYes);
with Block^ do
begin
if Start.Col = Stop.Col then
ColHeadersHash.Delete(Start.Col)
else
for C := Start.Col to Stop.Col do
ColHeadersHash.Delete(C);
end; {...with Block^ }
end; {...TSpreadSheet.DeleteColHeaders }
procedure TSpreadSheet.DeleteColumns;
{ Deletes a column or group of columns }
var
Start, Stop : CellPos;
H : HashItemPtr;
CellPtr : PCell;
Block : TBlock;
Columns, EndDelCol : Word;
S : TBufStream;
Items: LongInt;
begin
Block.Start.Col := 0;
Block.Start.Row := 0;
Block.Stop.Col := 0;
Block.Stop.Row := 0;
if BlockOn then
begin
if CurrBlock^.Start.Col <= LastPos.Col then
begin
with Block do
begin
Start.Col := CurrBlock^.Start.Col;
Start.Row := 1;
if CurrBlock^.Stop.Col > LastPos.Col then
Stop.Col := LastPos.Col
else
Stop.Col := CurrBlock^.Stop.Col;
Stop.Row := LastPos.Row;
end; {...with Block }
end; {...if CurrBlock^.Start.Col <= LastPos.Col }
Columns := Succ(CurrBlock^.Stop.Col - CurrBlock^.Start.Col);
EndDelCol := CurrBlock^.Stop.Col;
end {...if BlockOn }
else
begin
if CurrPos.Col <= LastPos.Col then
begin
with Block do
begin
Start.Col := CurrPos.Col;
Start.Row := 1;
Stop.Col := CurrPos.Col;
Stop.Row := LastPos.Row;
end; {...with Block }
end; {...if CurrPos.Col <= LastPos.Col }
Columns := 1;
EndDelCol := CurrPos.Col;
end; {...if/else }
MessageDialog := PDialog(GLResFile^.Get('UpdatingTablesDialog'));
if Application^.ValidView(MessageDialog) <> nil then
Desktop^.Insert(MessageDialog)
else
begin
MessageDialog := nil;
Exit;
end; { else }
DeleteColFromHash(Block, Columns, EndDelCol);
SetScreenColStart(ScreenBlock^.Start.Col);
if AutoCalc then
Recalc(DisplayNo);
if MessageDialog <> nil then
begin
Desktop^.Delete(MessageDialog);
Dispose(MessageDialog, Done);
MessageDialog := nil;
end; { if }
DrawView;
end; {...TSpreadSheet.DeleteColumns }
procedure TSpreadSheet.DeleteRowFromHash(Block: TBlock; Rows, EndDelRow:
Word);
{ Deletes a row or block of rows from the hash tables }
var
Pos, Start, Stop : CellPos;
H : HashItemPtr;
CellPtr : PCell;
Deleted : Boolean;
F : File;
begin
SetChanged(ModifiedYes);
DeleteBlock(Block, Deleted);
with CellHash do
begin
CellPtr := FirstItem;
while CellPtr <> nil do
begin
with CellPtr^ do
begin
if CellPtr^.ShouldUpdate then
FixFormulaRow(CellPtr, opDelete, EndDelRow, Rows, MaxCols, MaxRows);
end; {...with CellPtr^ }
CellPtr := NextItem;
end; {...while CellPtr <> nil }
end; {...with CellHash }
Stop.Col := MaxInt;
Stop.Row := Block.Stop.Row;
FormatHash.Delete(Block.Start, Stop);
with FormatHash do
begin
H := FirstItem;
while H <> nil do
begin
Move(H^.Data, Start, SizeOf(Start));
Move(H^.Data[SizeOf(CellPos)], Stop, SizeOf(Stop));
if (Start.Row > (EndDelRow - Rows)) and (Stop.Row <= EndDelRow) then
Delete(Start, Stop)
else
begin
if Start.Row > EndDelRow then
begin
Dec(Start.Row, Rows);
Move(Start, H^.Data, Sizeof(Start));
end; {...if Start.Row > EndDelRow }
if Stop.Row > EndDelRow then
begin
Dec(Stop.Row, Rows);
Move(Stop, H^.Data[Sizeof(CellPos)], Sizeof(Stop));
end; {...if Stop.Row > EndDelRow }
end; {...if/else }
H := NextItem;
end; {...while H <> nil }
end; {...with FormatHash }
Stop.Col := MaxInt;
Stop.Row := Block.Stop.Row;
UnlockedHash.Delete(Block.Start, Stop);
with UnlockedHash do
begin
H := FirstItem;
while H <> nil do
begin
Move(H^.Data, Start, SizeOf(Start));
Move(H^.Data[SizeOf(CellPos)], Stop, SizeOf(Stop));
if (Start.Row > (EndDelRow - Rows)) and (Stop.Row <= EndDelRow) then
Delete(Start, Stop)
else
begin
if Start.Row > EndDelRow then
begin
Dec(Start.Row, Rows);
Move(Start, H^.Data, Sizeof(Start));
end; {...if Start.Row > EndDelRow }
if Stop.Row > EndDelRow then
begin
Dec(Stop.Row, Rows);
Move(Stop, H^.Data[Sizeof(CellPos)], Sizeof(Stop));
end; {...if Stop.Row > EndDelRow }
end; {...if/else }
H := NextItem;
end; {...while H <> nil }
end; {...with UnlockedHash }
StoreTablesToTempFile;
DoneHashTables;
Pos.Col := 0;
Pos.Row := Succ(EndDelRow);
LoadTablesFromTempFile(Pos, -Rows, 0);
Assign(F, GLStringList^.Get(sTempFileName));
Erase(F);
if LastPos.Row > 1 then
Dec(LastPos.Row, Rows);
Pos.Row := EndDelRow - Rows;
if Deleted then
Pos.Col := LastPos.Col
else
Pos.Col := 1;
FindLastPos(Pos);
SetChanged(ModifiedYes);
FixOverWrite;
end; {...TSpreadSheet.DeleteRowFromHash }
procedure TSpreadSheet.DeleteRows;
{ Deletes a row or a group of rows }
var
Start, Stop : CellPos;
H : HashItemPtr;
CellPtr : PCell;
Block : TBlock;
EndDelRow, Rows : Word;
begin
Block.Start.Col := 0;
Block.Start.Row := 0;
Block.Stop.Col := 0;
Block.Stop.Row := 0;
if BlockOn then
begin
if CurrBlock^.Start.Row <= LastPos.Row then
begin
with Block do
begin
Start.Col := 1;
Start.Row := CurrBlock^.Start.Row;
Stop.Col := LastPos.Col;
if CurrBlock^.Stop.Row > LastPos.Row then
Stop.Row := LastPos.Row
else
Stop.Row := CurrBlock^.Stop.Row;
end; {...with Block }
end; {...if CurrBlock^.Start.Row <= LastPos.Row }
Rows := Succ(CurrBlock^.Stop.Row - CurrBlock^.Start.Row);
EndDelRow := CurrBlock^.Stop.Row;
end {...if BlockOn }
else
begin
if CurrPos.Row <= LastPos.Row then
begin
with Block do
begin
Start.Col := 1;
Start.Row := CurrPos.Row;
Stop.Col := LastPos.Col;
Stop.Row := CurrPos.Row;
end; {...with Block }
end; {if CurrPos.Row <= LastPos.Row }
Rows := 1;
EndDelRow := CurrPos.Row;
end; {...if/else }
MessageDialog := PDialog(GLResFile^.Get('UpdatingTablesDialog'));
if Application^.ValidView(MessageDialog) <> nil then
Desktop^.Insert(MessageDialog)
else
begin
MessageDialog := nil;
Exit;
end; { else }
DeleteRowFromHash(Block, Rows, EndDelRow);
if AutoCalc then
Recalc(DisplayNo);
if MessageDialog <> nil then
begin
Desktop^.Delete(MessageDialog);
Dispose(MessageDialog, Done);
MessageDialog := nil;
end; { if }
DrawView;
end; {...TSpreadSheet.DeleteRows }
procedure TSpreadSheet.DisplayAllCells;
{ Displays all the cells in the current screen block }
begin
ClearScreenArea(@DisplayArea);
DisplayBlock(ScreenBlock^);
end; {...TSpreadSheet.DisplayAllCells }
procedure TSpreadSheet.DisplayBlock(B: TBlock);
{ Displays a block of cells }
begin
with B do
DisplayCellBlock(Start.Col, Start.Row, Succ(Stop.Col), Stop.Row);
end; {...TSpreadSheet.DisplayBlock }
procedure TSpreadsheet.DisplayBlockDiff(B1, B2 : TBlock);
{ Displays the cells present in one block, not present in the another block }
var
Pass : Byte;
B : TBlock;
RefBlock, Block2, TempBlock : PBlock;
begin
if Compare(B1, B2, SizeOf(TBlock)) then
Exit;
Pass := 0;
RefBlock := @B1;
Block2 := @B2;
repeat
Inc(Pass);
if Block2^.Start.Col < RefBlock^.Start.Col then
begin
if Block2^.Start.Row < RefBlock^.Start.Row then
begin
B.Start := Block2^.Start;
B.Stop.Col := Pred(RefBlock^.Start.Col);
B.Stop.Row := Pred(RefBlock^.Start.Row);
DisplayBlock(B);
end; {...if Block2^.Start.Row < RefBlock^.Start.Row }
if (Block2^.Start.Row >= RefBlock^.Start.Row) and
(Block2^.Start.Row <= RefBlock^.Stop.Row) then
begin
B.Start.Col := Block2^.Start.Col;
B.Start.Row := Block2^.Start.Row;
B.Stop.Col := Pred(RefBlock^.Start.Col);
B.Stop.Row := RefBlock^.Stop.Row;
DisplayBlock(B);
end {...if (Block2^.Start.Row >= RefBlock^.Start.Row) and ... }
else if Block2^.Stop.Row <= RefBlock^.Stop.Row then
begin
B.Start.Col := Block2^.Start.Col;
B.Start.Row := RefBlock^.Start.Row;
B.Stop.Col := Pred(RefBlock^.Start.Col);
B.Stop.Row := Min(RefBlock^.Stop.Row, Block2^.Stop.Row);
DisplayBlock(B);
end; {...else if Block2^.Stop.Row <= RefBlock^.Stop.Row }
if Block2^.Stop.Row > RefBlock^.Stop.Row then
begin
B.Start.Col := Block2^.Start.Col;
B.Start.Row := Succ(RefBlock^.Stop.Row);
B.Stop.Col := Pred(RefBlock^.Start.Col);
B.Stop.Row := Block2^.Stop.Row;
DisplayBlock(B);
end; {...if Block2^.Stop.Row > RefBlock^.Stop.Row }
end; {...if Block2^.Start.Col < RefBlock^.Start.Col }
if Block2^.Start.Row < RefBlock^.Start.Row then
begin
if (Block2^.Start.Col >= RefBlock^.Start.Col) and
(Block2^.Start.Col <= RefBlock^.Stop.Col) then
begin
B.Start.Col := Block2^.Start.Col;
B.Start.Row := Block2^.Start.Row;
B.Stop.Col := RefBlock^.Stop.Col;
B.Stop.Row := Pred(RefBlock^.Start.Row);
DisplayBlock(B);
end {...if (Block2^.Start.Col >= RefBlock^.Start.Col) and ... }
else if Block2^.Stop.Col <= RefBlock^.Stop.Col then
begin
B.Start.Col := RefBlock^.Start.Col;
B.Start.Row := Block2^.Start.Row;
B.Stop.Col := Min(RefBlock^.Stop.Col, Block2^.Stop.Col);
B.Stop.Row := Pred(RefBlock^.Start.Row);
DisplayBlock(B);
end; {...else if Block2^.Stop.Col <= RefBlock^.Stop.Col }
end; {...if Block2^.Start.Row < RefBlock^.Start.Row }
if Block2^.Stop.Row > RefBlock^.Stop.Row then
begin
if (Block2^.Start.Col >= RefBlock^.Start.Col) and
(Block2^.Start.Col <= RefBlock^.Stop.Col) then
begin
B.Start.Col := Block2^.Start.Col;
B.Start.Row := Succ(RefBlock^.Stop.Row);
B.Stop.Col := RefBlock^.Stop.Col;
B.Stop.Row := Block2^.Stop.Row;
DisplayBlock(B);
end {...if (Block2^.Start.Col >= RefBlock^.Start.Col) and ... }
else if Block2^.Stop.Col <= RefBlock^.Stop.Col then
begin
B.Start.Col := RefBlock^.Start.Col;
B.Start.Row := Succ(RefBlock^.Stop.Row);
B.Stop.Col := Min(RefBlock^.Stop.Row, Block2^.Stop.Row);
B.Stop.Row := Block2^.Stop.Row;
DisplayBlock(B);
end; {...else if Block2^.Stop.Col <= RefBlock^.Stop.Col }
end; {...if Block2^.Stop.Row > RefBlock^.Stop.Row }
if Block2^.Stop.Col > RefBlock^.Stop.Col then
begin
if Block2^.Start.Row < RefBlock^.Start.Row then
begin
B.Start.Col := Succ(RefBlock^.Stop.Col);
B.Start.Row := Block2^.Start.Row;
B.Stop.Col := Block2^.Stop.Col;
B.Stop.Row := Pred(RefBlock^.Start.Row);
DisplayBlock(B);
end; {...if Block2^.Start.Row < RefBlock^.Start.Row }
if (Block2^.Start.Row >= RefBlock^.Start.Row) and
(Block2^.Start.Row <= RefBlock^.Stop.Row) then
begin
B.Start.Col := Succ(RefBlock^.Stop.Col);
B.Start.Row := Block2^.Start.Row;
B.Stop.Col := Block2^.Stop.Col;
B.Stop.Row := RefBlock^.Stop.Row;
DisplayBlock(B);
end {...if (Block2^.Start.Row >= RefBlock^.Start.Row) and ... }
else if Block2^.Stop.Row <= RefBlock^.Stop.Row then
begin
B.Start.Col := Succ(RefBlock^.Stop.Col);
B.Start.Row := RefBlock^.Start.Row;
B.Stop.Col := Block2^.Stop.Col;
B.Stop.Row := Min(RefBlock^.Stop.Row, Block2^.Stop.Row);
DisplayBlock(B);
end; {...else if Block2^.Stop.Row <= RefBlock^.Stop.Row }
if Block2^.Stop.Row > RefBlock^.Stop.Row then
begin
B.Start.Col := Succ(RefBlock^.Stop.Col);
B.Start.Row := Succ(RefBlock^.Stop.Row);
B.Stop := Block2^.Stop;
DisplayBlock(B);
end; {...if Block2^.Stop.Row > RefBlock^.Stop.Row }
end; {...if Block2^.Stop.Col > RefBlock^.Stop.Col }
TempBlock := RefBlock;
RefBlock := Block2;
Block2 := TempBlock;
until (Pass = 2);
end; {...TSpreadSheet.DisplayBlockDiff }
procedure TSpreadsheet.DisplayCell(P : CellPos);
{ Displays a single cell }
var
Color : Byte;
S : String[ScreenCols];
B : TDrawBuffer;
Col : Byte;
begin
S := CellToFString(P, Color);
MoveStr(B, S, Color);
Col := ColToX(P.Col);
WriteLine(Col, RowToY(P.Row), Min(Length(S), (Size.X - Col)), 1, B);
end; {...TSpreadSheet.DisplayCell }
procedure TSpreadSheet.DisplayCellBlock(C1, R1, C2, R2: Word);
{ Displays a block of cells }
var
P : CellPos;
begin
with ScreenBlock^ do
begin
for P.Row := Max(R1, Start.Row) to Min(R2, Stop.Row) do
for P.Col := Max(C1, Start.Col) to Min(C2, Succ(Stop.Col)) do
DisplayCell(P);
end; {...with ScreenBlock^ }
end; {...TSpreadSheet.DisplayCellBlock }
procedure TSpreadSheet.DisplayCellData;
var
InfoStringLength, W : Byte;
CP : PCell;
CurrWidth, LockedState, S : String;
B : TDrawBuffer;
Pos : CellPos;
const
BlockInfoSize = 30;
CellInfoSize = 28;
begin
if (State and sfActive <> 0) then
Pos := CurrPos
else
Pos := OldCurrPos;
CP := CellHash.Search(Pos);
ClearScreenArea(@DataArea);
Str(ColWidth(Pos.Col), CurrWidth);
LockedState := '';
if UnlockedHash.Search(Pos) then
LockedState := GLStringList^.Get(sCellUnLockedInfo)
else
if SheetProtected then
LockedState := GLStringList^.Get(sCellLockedInfo);
with DataArea do
begin
S := LeftJustStr(ColToString(Pos.Col) + RowToString(Pos.Row) +
' [' + GLStringList^.Get(sWidthLetter) + CurrWidth + '] ' + CP^.Name +
' ' + LockedState, CellInfoSize);
InfoStringLength := CellInfoSize;
if BlockOn then
begin
with CurrBlock^ do
begin
S := S + LeftJustStr(GLStringList^.Get(sBlockName) +
ColToString(Start.Col) + RowToString(Start.Row) + '..' +
ColToString(Stop.Col) + RowToString(Stop.Row), BlockInfoSize);
InfoStringLength := InfoStringLength + BlockInfoSize
end; {...with CurrBlock^ }
end; {...if BlockOn }
MoveStr(B, S, GetColor(8));
WriteLine(UpperLeft.Col, UpperLeft.Row, InfoStringLength, 1, B);
end; {...with DataArea }
with ContentsArea do
begin
S := LeftJustStr(CP^.DisplayString(DisplayFormulas, MaxDecimalPlaces),
Succ(LowerRight.Col-UpperLeft.Col));
MoveStr(B, S, GetColor(9));
WriteLine(UpperLeft.Col, UpperLeft.Row, Length(S), 1, B);
end; {...with ContenstArea }
end; {...TSpreadSheet.DisplayCellData }
procedure TSpreadSheet.DisplayCols;
{ Displays the column headers }
var
W, X : Byte;
C : Integer;
B : TDrawBuffer;
begin
with ScreenBlock^ do
begin
if not NoBlankArea then
begin
X := ColStart^[Stop.Col - Start.Col]+ColWidth(Stop.Col);
W := Max(Size.X - X, Size.X);
MoveChar(B, ' ', ColArea.Attrib, W);
WriteLine(X, ColArea.UpperLeft.Row, W, 1, B);
end; {...if not NoBlankArea }
for C := Start.Col to Min(Succ(Stop.Col), MaxCols) do
begin
W := ColWidth(C);
MoveStr(B, CenterStr(ColumnToString(C), W), ColArea.Attrib);
WriteLine (ColStart^[C - Start.Col], ColArea.UpperLeft.Row, W, 1, B);
end; {...for C }
end; {...with ScreenBlock^ }
end; {...TSpreadSheet.DisplayCols }
procedure TSpreadSheet.DisplayInfo;
{ Displays the spreadsheet's info characters }
var
Width : Byte;
Info : String;
B : TDrawBuffer;
begin
ClearScreenArea(@InfoArea);
with InfoArea do
begin
Width := Succ(LowerRight.Col - UpperLeft.Col);
Info := ColToString(GetNumber);
if Modified then
Info := Copy(Info, 1, 1) + '*';{Chr(4);}
if Length(Info) = 1 then
Info := Info + ' ';
if GoToEnd then
Info := Info + GLStringList^.Get(sEndKeyPressedLetter)
else
Info := Info + ' ';
if DisplayHeaders then
Info := Info + GLStringList^.Get(sDisplayHeadersLetter)
else
Info := Info + ' ';
if AutoCalc then
Info := Info + GLStringList^.Get(sAutoCalcLetter)
else
Info := Info + ' ';
if DisplayFormulas then
Info := Info + GLStringList^.Get(sDisplayFormulasLetter)
else
Info := Info + ' ';
MoveStr(B, Info, Attrib);
Writeline (UpperLeft.Col, UpperLeft.Row, Min(Width, Length(Info)), 1, B);
end; {...with InfoArea }
end; {...TSpreadSheet.DisplayInfo }
procedure TSpreadSheet.DisplayRows;
{ Displays row numbers }
var
R : Integer;
B : TDrawBuffer;
begin
with ScreenBlock^ do
begin
for R := Start.Row to Stop.Row do
with RowArea do
begin
MoveStr(B, LeftJustStr(RowToString(R), RowNumberSpace),
RowArea.Attrib);
WriteLine(UpperLeft.Col, R - Start.Row + UpperLeft.Row,
RowNumberSpace, 1, B);
end; {...with RowArea }
end; {...with ScreenBlock^ }
end; {...TSpreadSheet.DisplayRows }
{****************************************************************************}
{ TSpreadSheet.DoAfterAddingCell }
{****************************************************************************}
procedure TSpreadSheet.DoAfterAddingCell;
{ This procedure is called after a cell is added or modified }
begin
MoveDown;
end;
{****************************************************************************}
{ TSpreadsheet.DoBeforeAddingCell }
{****************************************************************************}
function TSpreadsheet.DoBeforeAddingCell;
begin
DoBeforeAddingCell := True;
end;
{****************************************************************************}
{ TSpreadSheet.DragCursorWithMouse }
{****************************************************************************}
procedure TSpreadSheet.DragCursorWithMouse(Event: TEvent);
{ Sets block mode on and extends the block to wherever the mouse is pointing }
var
ColScrPos : Byte;
OldPos : CellPos;
Counter : Integer;
Mouse : TPoint;
begin
MakeLocal(Event.Where, Mouse);
with ScreenBlock^ do
begin
KeyPressed := True;
if not BlockOn then ToggleBlockOn;
OldPos := CurrPos;
if Mouse.Y < DisplayArea.UpperLeft.Row then
begin
CurrPos.Row := Max(1, Pred(Start.Row));
SetScreenRowStart(CurrPos.Row);
VScrollBar^.SetValue(ScreenBlock^.Start.Row);
end {...if Mouse.Y < DisplayArea.UpperLeft.Row }
else if Mouse.Y > DisplayArea.LowerRight.Row then
begin
CurrPos.Row := Min(MaxRows, Succ(Stop.Row));
SetScreenRowStop(CurrPos.Row);
VScrollBar^.SetValue(ScreenBlock^.Start.Row);
end {...if Mouse.Y > DisplayArea.LowerRight.Row }
else
CurrPos.Row := YToRow(Mouse.Y);
if (Mouse.X >= Size.X) then
begin
CurrPos.Col := Min(MaxCols, Succ(Stop.Col));
SetScreenColStop(CurrPos.Col);
HScrollBar^.SetValue(ScreenBlock^.Start.Col);
end {...if (Mouse.X >= Size.X) or... }
else if Mouse.X < RowNumberSpace then
begin
CurrPos.Col := Max(1, Pred(Start.Col));
SetScreenColStart(CurrPos.Col);
HScrollBar^.SetValue(ScreenBlock^.Start.Col);
end {...else if Mouse.X < RowNumberSpace }
else
CurrPos.Col := XToCol(Mouse.X);
MoveCell(OldPos);
KeyPressed := False;
end; {...with ScreenBlock^ }
end; {...TSpreadSheet.DragCursorWithMouse }
procedure TSpreadSheet.Draw;
{ Sets the spreadsheet areas and displays all the spreadsheet's components }
var
R : TRect;
begin
GetExtent(R);
Inc(R.A.Y, EmptyRowsAtTop);
Dec(R.B.Y, EmptyRowsAtBottom);
SetAreas(R);
DisplayCols;
DisplayRows;
DisplayInfo;
DisplayAllCells;
DisplayCellData;
end; {...TSpreadSheet.Draw }
procedure TSpreadSheet.EraseCellBlock(EraseBlock: Boolean);
{ Deletes a cell or block of cells }
var
Deleted: Boolean;
Pos : CellPos;
begin
Deleted := False;
if not BlockOn or not EraseBlock then
begin
if not SheetProtected or (SheetProtected and
UnlockedHash.Search(CurrPos)) then
begin
DeleteCell(CurrPos, Deleted);
Pos := CurrPos;
end {...if not SheetProtected or ... }
else
MessageBox(GLStringList^.Get(sCellsProtectedMsg), nil, mfInformation +
mfOKButton);
end {...if not BlockOn or not EraseBlock }
else
begin
if not CellsProtected(CurrBlock^) then
begin
DisplayMessage(GLStringList^.Get(sBlockDeleteMsg));
DeleteBlock(CurrBlock^, Deleted);
EraseMessage;
Pos := CurrBlock^.Stop;
if Deleted then
ClearCurrBlock;
end {...if not CellsProtected(CurrBlock^) }
else
MessageBox(GLStringList^.Get(sCellsProtectedMsg), nil, mfInformation +
mfOKButton);
end; {...if/else }
if Deleted then
begin
Desktop^.Lock;
FindLastPos(Pos);
SetChanged(ModifiedYes);
if AutoCalc then
Recalc(DisplayYes);
DisplayAllCells;
DisplayCellData;
Desktop^.Unlock;
end; {...if Deleted }
end; {...TSpreadSheet.EraseCellBlock }
procedure TSpreadSheet.ExtendCurrBlock(Redraw : Boolean);
{ Resizes the current block if active }
var
OldBlock : TBlock;
begin
if BlockOn then
begin
Move(CurrBlock^, OldBlock, SizeOf(CurrBlock^));
if CurrBlock^.ExtendTo(CurrPos) then
begin
if Redraw then
DisplayBlockDiff(OldBlock, CurrBlock^);
end {...if CurrBlock^.ExtendTo(CurrPos) }
else
ClearCurrBlock;
end; {...if BlockOn }
end; {...TSpreadSheet.ExtendCurrBlock }
procedure TSpreadsheet.FindLastPos(DPos : CellPos);
{ Finds the lower left corner of smallest block containing used cells }
var
ColFound, RowFound : Boolean;
CellPtr : PCell;
Counter : Word;
begin
with CellHash do
begin
ColFound := DPos.Col < LastPos.Col;
RowFound := DPos.Row < LastPos.Row;
if (not ColFound) or (not RowFound) then
begin
if not ColFound then
LastPos.Col := 1;
if not RowFound then
LastPos.Row := 1;
CellPtr := FirstItem;
while CellPtr <> nil do
begin
if not ColFound then
begin
if CellPtr^.Loc.Col > LastPos.Col then
begin
LastPos.Col := CellPtr^.Loc.Col;
if HScrollBar <> nil then
PLimScrollBar(HScrollBar)^.DisplayLimit :=
Max(DefaultHScrollBarLimit, LastPos.Col);
ColFound := LastPos.Col = DPos.Col;
if ColFound and RowFound then
Exit;
end; {...if CellPtr^.Loc.Col > LastPos.Col }
end; {...if not ColFound }
if not RowFound then
begin
if CellPtr^.Loc.Row > LastPos.Row then
begin
LastPos.Row := CellPtr^.Loc.Row;
if VScrollBar <> nil then
PLimScrollBar(VScrollBar)^.DisplayLimit :=
Max(DefaultVScrollBarLimit, LastPos.Row);
RowFound := LastPos.Row = DPos.Row;
if ColFound and RowFound then
Exit;
end; {...if CellPtr^.Loc.Row > LastPos.Row }
end; {...if not RowFound }
CellPtr := NextItem;
end; {...while CellPtr <> nil }
end; {...if (not ColFound) or (not RowFound) }
end; {...with CellHash }
end; {...TSpreadSheet.FindLastPos }
procedure TSpreadSheet.FindScreenColStart;
{ Find the starting screen column when the ending column is known}
var
Temp, Width : Byte;
Index, Place : Integer;
begin
with ScreenBlock^ do
begin
Index := 0;
Place := Succ(DisplayArea.LowerRight.Col);
Width := ColWidth(Stop.Col);
repeat
ColStart^[Index] := Max(DisplayArea.UpperLeft.Col, Place - Width);
Dec(Place, Width);
Inc(Index);
if (Stop.Col - Index = 0) then
Width := 0
else
Width := ColWidth(Stop.Col - Index);
until (Width = 0) or (Place - Width < DisplayArea.UpperLeft.Col);
Start.Col := Succ(Stop.Col - Index);
Dec(Index);
if ColStart^[Index] > DisplayArea.UpperLeft.Col then
begin
Temp := ColStart^[Index] - DisplayArea.UpperLeft.Col;
for Place := 0 to Index do
Dec(ColStart^[Place], Temp);
end; {...if ColStart^[Index] > DisplayArea.UpperLeft.Col }
if Index > 0 then
begin
for Place := 0 to (Pred(Index) shr 1) do
begin
Temp := ColStart^[Index - Place];
ColStart^[Index - Place] := ColStart^[Place];
ColStart^[Place] := Temp;
end; {...for Place }
end; {...if Index > 0 }
ColStart^[Succ(Index)] := ColStart^[Index] + ColWidth(Stop.Col);
end; {...with ScreenBlock^ }
end; {...TSpreadSheet.FindScreenColStart }
procedure TSpreadSheet.FindScreenColStop;
{ Finds then ending screen column when the starting column is known }
var
Index, Place, Width : Byte;
begin
with ScreenBlock^ do
begin
for Index := 1 to 10 do
ColStart^[Index] := 0;
Index := 0;
Place := DisplayArea.UpperLeft.Col;
Width := ColWidth(Start.Col);
repeat
ColStart^[Index] := Place;
Inc(Place, Width);
Inc(Index);
if (Integer(Index) + Start.Col > MaxCols) then
Width := 0
else
Width := ColWidth(Index + Start.Col);
until (Width = 0) or
(Place + Width > Succ(DisplayArea.LowerRight.Col));
ColStart^[Index] := Place;
Stop.Col := Pred(Start.Col + Index);
end; {...with ScreenBlock^ }
end; {...TSpreadSheet.FindScreenColStop }
procedure TSpreadSheet.FindScreenRowStart;
{ Finds the starting screen row when the ending row is know }
begin
with ScreenBlock^ do
begin
if LongInt(Stop.Row) - TotalRows < 0 then
begin
Start.Row := 1;
FindScreenRowStop;
end {if LongInt(Stop.Row) - TotalRows < 0 }
else
Start.Row := Succ(Stop.Row - TotalRows);
end; {...with ScreenBlock^ }
end; {...TSpreadSheet.FindScreenRowStart }
procedure TSpreadSheet.FindScreenRowStop;
{ Finds the ending screen row when the starting row is know }
begin
with ScreenBlock^ do
begin
if LongInt(Start.Row) + TotalRows > Succ(LongInt(MaxRows)) then
begin
Stop.Row := MaxRows;
FindScreenRowStart;
end {if (LongInt(Start.Row) + TotalRows) > Succ(MaxRows) }
else
Stop.Row := Pred(Start.Row + TotalRows);
end; {...with ScreenBlock^ }
end; {...TSpreadSheet.FindScreenRowStop }
procedure TSpreadSheet.FixBlockOverWrite(Block: TBlock);
{ Updates the overwrite information of a block of cells
IMPORTANT: No memory checking is done since it is assumed that no
cells were added to the block being updated }
var
CP, D : PCell;
begin
with CellHash do
begin
CP := FirstItem;
while CP <> nil do
begin
if Block.CellInBlock(CP^.Loc) then
begin
OverWriteHash.Delete(CP^.Loc, CellHash, FormatHash, WidthHash,
LastPos, MaxCols, GetColWidth, DisplayFormulas, ChangeNo);
OverwriteHash.Add(CP, CellHash, FormatHash, WidthHash, LastPos,
MaxCols, GetColWidth, DisplayFormulas, ChangeNo);
end; {...if Block.CellInBlock(CP^.Loc) }
CP := NextItem;
end; {...while CP <> nil}
end; {...with CellHash }
end; {...TSpreadSheet.FixBlockOverWrite }
function TSpreadsheet.FixOverWrite: Boolean;
{ Updates the overwrite information for each cell in the spreadsheet }
var
CP, D : PCell;
begin
FixOverWrite := False;
with CellHash do
begin
CP := FirstItem;
while CP <> nil do
begin
if not OverwriteHash.Add(CP, CellHash, FormatHash, WidthHash, LastPos,
MaxCols, GetColWidth, DisplayFormulas, ChangeYes) then
begin
CellHash.Delete(CP^.Loc, D);
Dispose(D, Done);
Exit;
end; {...if not OverwriteHash.Add }
CP := NextItem;
end; {...while CP <> nil }
end; {...with CellHash }
FixOverWrite := True;
end; {...TSpreadSheet.FixOverWrite }
procedure TSpreadSheet.FormatDefault;
{ Clears the custom assigned formats of a block of cells }
var
Block : TBlock;
begin
with Block do
begin
if BlockOn then
begin
Start := CurrBlock^.Start;
Stop := CurrBlock^.Stop;
end {...if BlockOn }
else
begin
Start := CurrPos;
Stop := CurrPos;
end; {...if/else }
end; {...with Block }
if not FormatHash.Delete(Block.Start, Block.Stop) then
Exit;
SetChanged(ModifiedYes);
FixBlockOverWrite(Block);
Block.Stop.Col := ScreenBlock^.Stop.Col;
DisplayBlock(Block);
end; {...TSpreadSheet.FormatDefault }
function TSpreadSheet.FStringSituationColor(P: CellPos; var CP: PCell;
var HasError, ColorFound: Boolean): Byte;
{ Returns situation especific colors of the string to be displayed in the
screen (for example: highlighted cell color, cell in block color, etc). }
function DisplayErrorColor: Boolean;
{ This function determines if the cell must be displayed in error color.
When the cell is a formula cell and DisplayFormulas mode is on, even
though HasError may return true, the cell should not be displayed
in error color }
begin
DisplayErrorColor := HasError and not (DisplayFormulas
and (CP^.CellType = ClFormula));
end; {...DisplayErrorColor }
begin
ColorFound := True;
CP := CellHash.Search(P);
HasError := CP^.HasError;
if not SheetProtected or (SheetProtected and not UnlockedHash.Search(P)) then
begin
if BlockOn and (SameCellPos(P, CurrPos)) then
begin
if not DisplayErrorColor then
FStringSituationColor := GetColor(13)
else
FStringSituationColor := GetColor(21);
end {...if BlockOn and (SameCellPos(P, CurrPos)) }
else if SameCellPos(P, CurrPos) then
begin
if not DisplayErrorColor then
FStringSituationColor := GetColor(12)
else
FStringSituationColor := GetColor(20);
end {...else if SameCellPos(P, CurrPos) }
else if BlockOn and (CurrBlock^.CellInBlock(P)) then
begin
if not DisplayErrorColor then
FStringSituationColor := GetColor(11)
else
FStringSituationColor := GetColor(19);
end {...else if BlockOn and (CurrBlock^.CellInBlock(P)) }
else
if not DisplayErrorColor then
ColorFound := False
else
FStringSituationColor := GetColor(18);
end {...if not SheetProtected or ... }
else
begin
if BlockOn and (SameCellPos(P, CurrPos)) then
begin
if not DisplayErrorColor then
FStringSituationColor := GetColor(17)
else
FStringSituationColor := GetColor(25);
end {...if BlockOn and (SameCellPos(P, CurrPos)) }
else if SameCellPos(P, CurrPos) then
begin
if not DisplayErrorColor then
FStringSituationColor := GetColor(16)
else
FStringSituationColor := GetColor(24);
end {...else if SameCellPos(P, CurrPos) }
else if BlockOn and (CurrBlock^.CellInBlock(P)) then
begin
if not DisplayErrorColor then
FStringSituationColor := GetColor(15)
else
FStringSituationColor := GetColor(23);
end {...else if BlockOn and (CurrBlock^.CellInBlock(P)) }
else
if not DisplayErrorColor then
FStringSituationColor := GetColor(14)
else
FStringSituationColor := GetColor(22);
end; {...if/else }
end; {...TSpreadSheet.FStringSituationColor }
procedure TSpreadSheet.FormatCells;
var
Cancel, ValidFormat : Boolean;
NewDecimalPlaces : Byte;
Start, Stop : CellPos;
NewCurrency: Char;
F : FormatType;
Code : Integer;
Dialog : PDialog;
ErrorString : String;
Block: TBlock;
const
CurrencyBit = $01;
CommasBit = $02;
procedure SetDialogFormatRec;
{ Determines the initial values for the format dialog's fields }
var
CellPtr : PCell;
begin
CellPtr := CellHash.Search(CurrPos);
if CellPtr <> Empty then
begin
F := CellPtr^.Format(FormatHash, DisplayFormulas);
with RFormat do
begin
NumberFormat := 0;
Justification := (F shr JustShift) and JustPart;
if (F and CurrencyPart) <> 0 then
NumberFormat := NumberFormat or CurrencyBit;
if (F and CommasPart) <> 0 then
NumberFormat := NumberFormat or CommasBit;
if ((F and DecPlacesPart) = 0) and
not ((CellPtr^.CellType = ClValue) or ((CellPtr^.CellType =
ClFormula)) and DisplayFormulas = True) then
Str(DefaultDecimalPlaces, DecimalPlaces)
else
Str(F and DecPlacesPart, DecimalPlaces);
if (F and CurrencyCharPart) <> 0 then
CurrencyChar := Char((F and CurrencyCharPart) shr CurrencyShift)
else
CurrencyChar := Copy(DefaultCurrency, 2, 1);
end; {...with RFormat }
end {...if CellPtr <> Empty }
else
begin
with RFormat do
begin
Justification := Ord(JLeft);
NumberFormat := 0;
Str(DefaultDecimalPlaces, DecimalPlaces);
CurrencyChar := Copy(DefaultCurrency, 2, 1);
end; {...with RFormat }
end; {...if/else }
end; {...SetDialogFormatRec }
procedure GetValidFormat(Dialog: PDialog; var ValidFormat, Cancel: Boolean);
{ Returns ValidFormat as true is a valid format was entered }
var
SelectedCommand : Word;
begin
SelectedCommand := Desktop^.ExecView(Dialog);
if SelectedCommand <> cmCancel then
begin
Dialog^.GetData(RFormat);
val(RFormat.DecimalPlaces, NewDecimalPlaces, Code);
if (NewDecimalPlaces > MaxDecimalPlaces) then
ErrorString := ErrorString + GLStringList^.Get(sFormatError1Msg)
else
ValidFormat := True;
if ((RFormat.NumberFormat and CurrencyBit) <> 0) then
begin
if not ((RFormat.CurrencyChar <> '') and
(RFormat.CurrencyChar <> ' ')) then
begin
ErrorString := ErrorString +
GLStringList^.Get(sFormatError2Msg);
ValidFormat := False;
end; {...if not ((RFormat.CurrencyChar<>'') and... }
end; {...if (RFormat.NumberFormat and CurrencyBit) <> 0) }
end {...if SelectedCommand <> cmCancel }
else
begin
Cancel := True;
ValidFormat := True;
end; {...if/else }
end; {...GetValidFormat }
begin
Cancel := False;
ValidFormat := False;
if BlockOn then
begin
Block.Start := CurrBlock^.Start;
Block.Stop := CurrBlock^.Stop;
end {...if BlockOn }
else
Block.Init(CurrPos);
Dialog := PDialog(GLResFile^.Get('FormatDialog'));
SetDialogFormatRec;
Dialog^.SetData(RFormat);
repeat
ErrorString := GLStringList^.Get(sFormatErrorMsg);
if (Application^.ValidView(Dialog) <> nil) then
GetValidFormat(Dialog, ValidFormat, Cancel)
else
Exit;
if not ValidFormat then
MessageBox(ErrorString, nil, mfError+mfOkButton);
until Cancel or ValidFormat;
if not Cancel then
begin
Dialog^.GetData(RFormat);
with RFormat do
begin
NewCurrency := CurrencyChar[1];
SetFormat(Block, NewDecimalPlaces, Justification, NumberFormat, NewCurrency);
end; { with }
SetChanged(ModifiedYes);
Block.Stop := ScreenBlock^.Stop;
DisplayBlock(Block);
end; {...else if not Cancel }
Dispose(Dialog, Done);
end; {...TSpreadSheet.FormatCells }
{****************************************************************************}
{ TSpreadSheet.GetNumber }
{****************************************************************************}
function TSpreadSheet.GetNumber: Integer;
begin
GetNumber := PWindow(Owner)^.Number;
end;
{****************************************************************************}
{ TSpreadSheet.GetPalette }
{****************************************************************************}
function TSpreadSheet.GetPalette: PPalette;
const
CPalette : string[Length(CSpreadSheet)] = CSpreadSheet;
begin
GetPalette := @CPalette;
end;
{****************************************************************************}
{ TSpreadSheet.GoToCell }
{****************************************************************************}
procedure TSpreadSheet.GoToCell;
{ Moves the highlight cursor to a user defined cell }
var
Cancel, CellEntered : Boolean;
OldPos, Pos : CellPos;
Dialog : PDialog;
FormLen : Word;
begin
Cancel := False;
CellEntered := False;
Dialog := PDialog(GLResFile^.Get('GoToDialog'));
repeat
if (Application^.ValidView(Dialog) <> nil) then
begin
if Desktop^.ExecView(Dialog) <> cmCancel then
begin
Dialog^.GetData(RGoToCell);
if not FormulaStart(RGoToCell.NewCell, 1, MaxCols, MaxRows, Pos,
FormLen) then
MessageBox(GLStringList^.Get(sInvalidCellMsg), nil, mfError +
mfOKButton)
else
CellEntered := True;
end {...if Desktop^.ExecView(Dialog) <> cmCancel }
else
Cancel := True;
end {...if Application^.ValidView(Dialog) <> nil }
else
Exit;
until CellEntered or Cancel;
if not Cancel then
GoToPos(Pos);
Dispose(Dialog, Done);
end;
{****************************************************************************}
{ TSpreadSheet.GoToPos }
{****************************************************************************}
procedure TSpreadSheet.GoToPos(Pos: CellPos);
var
OldPos : CellPos;
begin
if not ScreenBlock^.CellInBlock(Pos) then
begin
CurrPos := Pos;
ExtendCurrBlock(RedrawYes);
SetScreenColStart(CurrPos.Col);
SetScreenRowStart(CurrPos.Row);
HScrollBar^.Value := ScreenBlock^.Start.Col;
VScrollBar^.Value := ScreenBlock^.Start.Row;
HScrollBar^.DrawView;
VScrollBar^.DrawView;
DrawView;
end { if }
else
begin
OldPos := CurrPos;
CurrPos := Pos;
MoveCell(OldPos);
end; { else }
end;
{****************************************************************************}
{ TSpreadSheet.HandleEvent }
{****************************************************************************}
procedure TSpreadSheet.HandleEvent(var Event: TEvent);
{ Handles all spreadsheet related events }
procedure CheckforClipBoardClose;
{ if the spreadsheet being closed is @self, it resets the clipboard }
begin
if ClipBoard.Active and (ClipBoard.SourceSpreadSheet = @Self) then
ToggleClipBoardOff;
end; {...CheckforClipBoardClose }
procedure EscPressed;
begin
if BlockOn then
begin
ClearCurrBlock;
DisplayCellData;
end; {...if BlockOn }
if ClipBoard.Active then
ToggleClipBoardOff;
end; {...EscPressed }
begin
case Event.What of
evKeyDown :
begin
if ClipBoard.Active and ((Event.KeyCode = kbDel) or
(Event.CharCode in [Chr(32)..Chr(255)])) then
ToggleClipBoardOff;
KeyPressed := True;
case Event.KeyCode of
kbCtrlLeft : MovePgLeft;
kbCtrlRight : MovePgRight;
kbDel : EraseCellBlock(RemoveSingleCell);
kbDown : MoveDown;
kbEnd : ToggleEnd;
kbEnter : if Clipboard.Active then
PasteCellBlock;
kbEsc : EscPressed;
kbHome : MoveHome;
KbLeft : MoveLeft;
kbPgDn : MovePgDown;
kbPgUp : MovePgUp;
kbRight : MoveRight;
kbUp : MoveUp;
end; {...case Event.KeyCode }
KeyPressed := False;
if Event.CharCode in [Chr(32)..Chr(255)] then
HandleInput(Event.CharCode, EditNo);
end; {...case Event.What of evKeyDown }
evMouseDown :
begin
if Event.Double then
SetNameWithMouse(Event)
else if not SelectColumn(Event) then
begin
LocateCursorWithMouse(Event);
while MouseEvent(Event, evMouseMove + evMouseAuto) do
begin
Desktop^.Lock;
DragCursorWithMouse(Event);
Desktop^.Unlock;
end; {...while MouseEvent(Event, evMouseMove + evMouseAuto) }
end; {...else if not SelectColumn(Event) }
end; {...case Event.What of evMouseDown }
evCommand:
begin
if ClipBoard.Active and not (Event.Command in [cmNewSheet, cmPaste,
cmNext, cmPrev, cmZoom, cmResize, cmClose]) then
ToggleClipBoardOff;
case Event.Command of
cmCut : MoveCellBlock;
cmPaste : PasteCellBlock;
cmClose : CheckforClipBoardClose;
cmCopy : CopyCellBlock;
cmClear : EraseCellBlock(RemoveBlock);
cmPrintSheet : Print;
cmChangeColWidth : ChangeColWidth;
cmDeleteColumns : DeleteColumns;
cmDeleteRows : DeleteRows;
cmInsertColumns : InsertColumns;
cmInsertRows : InsertRows;
cmEditCell : HandleInput('', EditYes);
cmFormatCells : FormatCells;
cmFormatDefault : FormatDefault;
cmGoToCell : GoToCell;
cmRecalc : Recalc(DisplayYes);
cmToggleAutoCalc : ToggleAutoCalc;
cmToggleFormulas : ToggleFormulaDisplay;
cmChangeColHeaders : ChangeColHeaders;
cmDeleteColHeaders :
begin
DeleteColHeaders(CurrBlock);
DisplayCols;
end; {...case Event.Command of cmDeleteColHeaders }
cmToggleHeaders : ToggleDisplayHeaders;
cmToggleProtection :
begin
SetProtection(not SheetProtected, True);
SetChanged(ModifiedYes);
end;
cmSetLocked : SetLocked;
cmSetUnlocked : SetUnlocked;
cmSortData : SortData;
end; {...case Event.Command }
end; {...case Event.What of evCommand }
end; {...case Event.What }
TScroller.HandleEvent(Event);
end; {...TSpreadSheet.HandleEvent }
procedure TSpreadSheet.HandleInput(FirstChar: String; Editing: Boolean);
{ Gets data from the user, validates it and creates the corresponding cell }
var
Deleted, FirstEdit, Good : Boolean;
CurrentPos : CellPos;
CellValue : Extended;
Code : Integer;
InputLine : PSheetInputLine;
StringInput : PString;
R : TRect;
procedure DisplayEnteredString;
var
B : TDrawBuffer;
begin
with ContentsArea do
begin
MoveChar(B, ' ', Attrib, ScreenCols);
Writeline(UpperLeft.Col, UpperLeft.Row, ScreenCols, 1, B);
MoveStr(B, Copy(StringInput^, Succ(InputLine^.FirstPos),
Min((Length(StringInput^) - InputLine^.FirstPos), ScreenCols)),
Attrib);
Writeline (Succ(UpperLeft.Col), UpperLeft.Row,
Min((Length(StringInput^) - InputLine^.FirstPos), ScreenCols), 1, B);
end; {...with ContenstArea }
end; {...DisplayEnteredString }
begin
if not SheetProtected or (SheetProtected and
UnlockedHash.Search(CurrPos)) then
begin
Good := True;
if TrackCursor then
UpdateScreenBlockDisplay;
GetMem(StringInput, 255);
if StringInput = nil then
begin
Application^.OutofMemory;
Exit;
end; {...if StringInput = nil }
GoToEnd := True;
ToggleEnd;
with ContentsArea do
begin
R.Assign(Succ(UpperLeft.Col), Succ(UpperLeft.Row),
Succ(LowerRight.Col), Succ(LowerRight.Row));
Inc(R.B.X);
Inc(R.B.Y);
if Editing then
begin
CellHash.Search(CurrPos)^.EditString(MaxDecimalPlaces, StringInput^);
FirstChar := StringInput^;
end; {...if Editing }
InputLine := PSheetInputLine(GLResFile^.Get('InputLine'));
InputLine^.SetBounds(R);
if Editing then
InputLine^.SetData(FirstChar)
else
begin
InputLine^.Data^ := FirstChar;
Inc(InputLine^.CurPos);
end; {...if/else }
FirstEdit := True;
Parser^.Init(@CellHash, StringInput, MaxCols, MaxRows);
repeat
if FirstEdit then
Owner^.ExecView(InputLine)
else
begin
InputLine^.CurPos := Pred(Parser^.Position);
if InputLine^.CurPos < (InputLine^.Size.X - 2) then
InputLine^.FirstPos := 0
else
InputLine^.FirstPos := Succ(InputLine^.CurPos -
(InputLine^.Size.X - 2));
Owner^.ExecView(InputLine);
end; {...if/else }
InputLine^.GetData(StringInput^);
if Length(StringInput^) > 0 then
begin
DisplayEnteredString;
Parser^.Parse;
if Parser^.TokenError = 0 then
begin
if DoBeforeAddingCell then
begin
DeleteCell(CurrPos, Deleted);
if Parser^.CType = ClFormula then
Parser^.Inp^ := UpperCase(Parser^.Inp^);
Good := AddCell (Parser^.CType, CurrPos, Parser^.ParseError,
Parser^.ParseValue, Parser^.Inp^);
end { if }
else
Parser^.TokenError := 1;
end; {...if Parser^.TokenError = 0 }
end; {...if Length(StringInput^) > 0 }
FirstEdit := False;
until (Length(StringInput^) = 0) or (Parser^.TokenError = 0) or
not Good;
if (Length(StringInput^) > 0) and Good then
begin
SetChanged(ModifiedYes);
if AutoCalc then
Recalc(DisplayYes);
CurrentPos := CurrPos;
DoAfterAddingCell;
for CurrentPos.Col := CurrPos.Col to ScreenBlock^.Stop.Col do
DisplayCell(CurrentPos);
end; {...if (Length(StringInput^) > 0) and Good }
end; {...with ContentsArea }
Dispose(InputLine, Done);
FreeMem(StringInput, 255);
DisplayCellData;
end {...if not SheetProtected or ... }
else
MessageBox(GLStringList^.Get(sCellsProtectedMsg), nil, mfInformation +
mfOKButton);
end; {...TSpreadSheet.HandleInput }
procedure TSpreadSheet.InitCurrPos;
{ Locates the cursor in the first column and in the first row }
begin
CurrPos.Col := 1;
CurrPos.Row := 1;
end; {...InitCurrPos }
{****************************************************************************}
{ TSpreadSheet.InsertColToHash }
{****************************************************************************}
procedure TSpreadSheet.InsertColToHash(Block: TBlock; Columns, StartInsCol:
Word);
{ Updates all the hash tables after a column or group of columns is inserted }
var
Pos, Start, Stop : CellPos;
Deleted : Boolean;
F : File;
H : HashItemPtr;
CellPtr : PCell;
Col : Word;
begin
SetChanged(ModifiedYes);
DeleteBlock(Block, Deleted);
with CellHash do
begin
CellPtr := FirstItem;
while CellPtr <> nil do
begin
with CellPtr^ do
begin
if (CellPtr^.ShouldUpdate) then
FixFormulaCol(CellPtr, opInsert, StartInsCol, Columns, MaxCols,
MaxRows);
end; {...with CellPtr^ }
CellPtr := NextItem;
end; {...while CellPtr <> nil }
end; {...with CellHash }
for Col := (MaxCols - Pred(Columns)) to MaxCols do
WidthHash.Delete(Col);
with WidthHash do
begin
H := FirstItem;
while H <> nil do
begin
if WordPTr(@H^.Data)^ >= StartInsCol then
Inc(WordPtr(@H^.Data)^, Columns);
H := NextItem;
end; {...with H <> nil }
end; {...with WidthHash }
Stop.Col := Block.Stop.Col;
Stop.Row := MaxInt;
FormatHash.Delete(Block.Start, Stop);
with FormatHash do
begin
H := FirstItem;
while H <> nil do
begin
Move(H^.Data, Start, SizeOf(Start));
Move(H^.Data[SizeOf(CellPos)], Stop, SizeOf(Stop));
if Start.Col >= StartInsCol then
begin
Inc(Start.Col, Columns);
Move(Start, H^.Data, Sizeof(Start));
end; {...if Start.Col >= StartInsCol }
if Stop.Col >= StartInsCol then
begin
Inc(Stop.Col, Columns);
Move(Stop, H^.Data[Sizeof(CellPos)], Sizeof(Stop));
end; {...if Stop.Col >= StartInsCol }
H := NextItem;
end; {...while H <> nil }
end; {...with FormatHash }
DeleteColHeaders(@Block);
with ColHeadersHash do
begin
for Col := (MaxCols - Pred(Columns)) to MaxCols do
Delete(Col);
H := FirstItem;
while H <> nil do
begin
if WordPTr(@H^.Data)^ >= StartInsCol then
Inc(WordPtr(@H^.Data)^, Columns);
H := NextItem;
end; {...with H <> nil }
end; {...with ColHeadersHash }
Stop.Col := Block.Stop.Col;
Stop.Row := MaxInt;
UnlockedHash.Delete(Block.Start, Stop);
with UnlockedHash do
begin
H := FirstItem;
while H <> nil do
begin
Move(H^.Data, Start, SizeOf(Start));
Move(H^.Data[SizeOf(CellPos)], Stop, SizeOf(Stop));
if Start.Col >= StartInsCol then
begin
Inc(Start.Col, Columns);
Move(Start, H^.Data, Sizeof(Start));
end; {...if Start.Col >= StartInsCol }
if Stop.Col >= StartInsCol then
begin
Inc(Stop.Col, Columns);
Move(Stop, H^.Data[Sizeof(CellPos)], Sizeof(Stop));
end; {...if Stop.Col >= StartInsCol }
H := NextItem;
end; {...while H <> nil }
end; {...with UnlockedHash }
StoreTablesToTempFile;
DoneHashTables;
Pos.Col := StartInsCol;
Pos.Row := 0;
LoadTablesFromTempFile(Pos, 0, Columns);
Assign(F, GLStringList^.Get(sTempFileName));
Erase(F);
LastPos.Col := Min(LastPos.Col + Columns, MaxCols);
if LastPos.Col = MaxCols then
Pos.Col := MaxCols
else
begin
if BlockOn then
Pos.Col := Pred(StartInsCol + Columns) + Columns
else
Pos.Col := StartInsCol + Columns;
end; {...if/else }
if Deleted then
Pos.Row := LastPos.Row
else
Pos.Row := 1;
FindLastPos(Pos);
FixOverWrite;
end; {...TSpreadSheet.InsertColToHash }
procedure TSpreadSheet.InsertColumns;
{ Inserts one or more columns at the current position }
var
Start, Stop: CellPos;
H : HashItemPtr;
CellPtr : PCell;
Block : TBlock;
Column, Columns, StartInsCol : Word;
begin
Block.Start.Col := 0;
Block.Start.Row := 0;
Block.Stop.Col := 0;
Block.Stop.Row := 0;
if BlockOn then
begin
Columns := Succ(CurrBlock^.Stop.Col - CurrBlock^.Start.Col);
StartInsCol := CurrBlock^.Start.Col;
if Pred(LastPos.Col + Columns) >= MaxCols then
begin
with Block do
begin
Start.Col := MaxCols - Pred(Columns);
Start.Row := 1;
Stop.Col := MaxCols;
Stop.Row := LastPos.Row;
end; {...with Block }
LastPos.Col := MaxCols;
end {...if Pred(LastPos.Col + Columns) >= MaxCols }
end {...if BlockOn }
else
begin
Columns := 1;
StartInsCol := CurrPos.Col;
if LastPos.Col = MaxCols then
begin
with Block do
begin
Start.Col := MaxCols;
Start.Row := 1;
Stop.Col := MaxCols;
Stop.Row := LastPos.Row;
end; {...with Block do }
end {...if LastPos.Col = MaxCols }
end; {...if/else }
MessageDialog := PDialog(GLResFile^.Get('UpdatingTablesDialog'));
if Application^.ValidView(MessageDialog) <> nil then
Desktop^.Insert(MessageDialog)
else
begin
MessageDialog := nil;
Exit;
end; { else }
InsertColToHash(Block, Columns, StartInsCol);
SetScreenColStart(ScreenBlock^.Start.Col);
if AutoCalc then
Recalc(DisplayNo);
if MessageDialog <> nil then
begin
Desktop^.Delete(MessageDialog);
Dispose(MessageDialog, Done);
MessageDialog := nil;
end; { if }
DrawView;
end; {...TSpreadSheet.InsertColumns }
{****************************************************************************}
{ TSpreadSheet.InsertRowToHash }
{****************************************************************************}
procedure TSpreadSheet.InsertRowToHash(Block: TBlock; Rows, StartInsRow:
Word);
{ Updates all the hash tables after a row or group of rows is deleted }
var
Pos, Start, Stop : CellPos;
Deleted : Boolean;
F : File;
H : HashItemPtr;
CellPtr : PCell;
begin
SetChanged(ModifiedYes);
DeleteBlock(Block, Deleted);
with CellHash do
begin
CellPtr := FirstItem;
while CellPtr <> nil do
begin
with CellPtr^ do
begin
if (CellPtr^.ShouldUpdate) then
FixFormulaRow(CellPtr, opInsert, StartInsRow, Rows, MaxCols,
MaxRows);
end; {...with CellPtr^ }
CellPtr := NextItem;
end; {...while CellPtr <> nil }
end; {...with CellHash }
Stop.Col := MaxInt;
Stop.Row := Block.Stop.Row;
FormatHash.Delete(Block.Start, Stop);;
with FormatHash do
begin
H := FirstItem;
while H <> nil do
begin
Move(H^.Data, Start, SizeOf(Start));
Move(H^.Data[SizeOf(CellPos)], Stop, SizeOf(Stop));
if Start.Row >= StartInsRow then
begin
Inc(Start.Row, Rows);
Move(Start, H^.Data, Sizeof(Start));
end; {...if Start.Row >= StartInsRow }
if Stop.Row >= StartInsRow then
begin
Inc(Stop.Row, Rows);
Move(Stop, H^.Data[Sizeof(CellPos)], Sizeof(Stop));
end; {...if Stop.Row >= StartInsRow }
H := NextItem;
end; {...while H <> nil }
end; {...with FormatHash }
Stop.Col := MaxInt;
Stop.Row := Block.Stop.Row;
UnlockedHash.Delete(Block.Start, Stop);
with UnlockedHash do
begin
H := FirstItem;
while H <> nil do
begin
Move(H^.Data, Start, SizeOf(Start));
Move(H^.Data[SizeOf(CellPos)], Stop, SizeOf(Stop));
if Start.Row >= StartInsRow then
begin
Inc(Start.Row, Rows);
Move(Start, H^.Data, Sizeof(Start));
end; {...if Start.Row >= StartInsRow }
if Stop.Row >= StartInsRow then
begin
Inc(Stop.Row, Rows);
Move(Stop, H^.Data[Sizeof(CellPos)], Sizeof(Stop));
end; {...if Stop.Row >= StartInsRow }
H := NextItem;
end; {...while H <> nil }
end; {...with UnlockedHash }
StoreTablesToTempFile;
DoneHashTables;
Pos.Col := 0;
Pos.Row := StartInsRow;
LoadTablesFromTempFile(Pos, Rows, 0);
Assign(F, GLStringList^.Get(sTempFileName));
Erase(F);
if Pred(LastPos.Row+Rows) < MaxRows then
LastPos.Row := Min(LastPos.Row + Rows, MaxRows);
if LastPos.Row = MaxRows then
Pos.Row := MaxRows
else
begin
if BlockOn then
Pos.Row := Pred(StartInsRow + Rows) + Rows
else
Pos.Row := StartInsRow + Rows;
end; {...if/else }
if Deleted then
Pos.Col := LastPos.Col
else
Pos.Col := 1;
FindLastPos(Pos);
FixOverWrite;
end; {...TSpreadSheet.InsertRowToHash }
procedure TSpreadSheet.InsertRows;
{ Inserts one or more rows at the current position }
var
Start, Stop: CellPos;
H : HashItemPtr;
CellPtr : PCell;
Block : TBlock;
Rows, StartInsRow : Word;
begin
Block.Start.Col := 0;
Block.Start.Row := 0;
Block.Stop.Col := 0;
Block.Stop.Row := 0;
if BlockOn then
begin
Rows := Succ(CurrBlock^.Stop.Row - CurrBlock^.Start.Row);
StartInsRow := CurrBlock^.Start.Row;
if Pred(LastPos.Row + Rows) >= MaxRows then
begin
with Block do
begin
Start.Col := 1;
Start.Row := MaxRows - Pred(Rows);
Stop.Col := LastPos.Col;
Stop.Row := MaxRows;
end; {...with Block }
LastPos.Row := MaxRows;
end {...if Pred(LastPos.Row + Rows) >= MaxRows }
end {...if BlockOn }
else
begin
Rows := 1;
StartInsRow := CurrPos.Row;
if LastPos.Row = MaxRows then
begin
with Block do
begin
Start.Col := 1;
Start.Row := MaxRows;
Stop.Col := LastPos.Col;
Stop.Row := MaxRows;
end; {...with Block }
end {...if LastPos.Row = MaxRows }
end; {...if/else }
MessageDialog := PDialog(GLResFile^.Get('UpdatingTablesDialog'));
if Application^.ValidView(MessageDialog) <> nil then
Desktop^.Insert(MessageDialog)
else
begin
MessageDialog := nil;
Exit;
end; { else }
InsertRowToHash(Block, Rows, StartInsRow);
if AutoCalc then
Recalc(DisplayNo);
if MessageDialog <> nil then
begin
Desktop^.Delete(MessageDialog);
Dispose(MessageDialog, Done);
MessageDialog := nil;
end; { if }
DrawView;
end; {...TSpreadSheet.InsertRows }
constructor TSpreadSheet.Load(var S: TStream);
{ Loads the spreadsheet object from a stream }
var
R : TRect;
AdjustPos : CellPos;
FileHeader : String[Length(OOGridFileHeader)];
const
MinRowsToDisplay = 2;
begin
AdjustPos.Col := 0;
AdjustPos.Row := 0;
TScroller.Load(S);
S.Read(FileHeader, SizeOf(FileHeader));
if FileHeader <> OOGridFileHeader then
begin
S.Error(stInvalidFormatError, 0);
Exit;
end; {...if FileHeader <> OOGridFileHeader }
S.Read(EmptyRowsAtTop, SizeOf(EmptyRowsAtTop));
S.Read(EmptyRowsAtBottom ,SizeOf(EmptyRowsAtBottom));
S.Read(MaxCols, SizeOf(MaxCols));
S.Read(MaxRows, SizeOf(MaxRows));
S.Read(DefaultColWidth, SizeOf(DefaultColWidth));
S.Read(DefaultDecimalPlaces, SizeOf(DefaultDecimalPlaces));
S.Read(MaxDecimalPlaces, SizeOf(MaxDecimalPlaces));
S.Read(DefaultCurrency, SizeOf(DefaultCurrency));
S.Read(LastPos, SizeOf(LastPos));
LoadHashTables(S, AdjustPos, 0, 0);
if S.Status <> 0 then
Exit;
if not FixOverWrite then
begin
S.Error(stNoMemoryError, 0);
Exit;
end; {...if not FixOverWrite }
ScreenBlock := PBlock(S.Get);
S.Read(CurrPos, SizeOf(CurrPos));
S.Read(BlockOn, SizeOf(BlockOn));
CurrBlock := PBlock(S.Get);
if S.Status <> 0 then
Exit;
S.Read(DisplayFormulas, SizeOf(DisplayFormulas));
S.Read(AutoCalc, SizeOf(AutoCalc));
S.Read(DisplayHeaders, SizeOf(DisplayHeaders));
S.Read(SheetProtected, SizeOf(SheetProtected));
if S.Status <> 0 then
Exit;
SetProtection(SheetProtected, False);
RowNumberSpace := 6;
MaxColWidth := ScreenCols - RowNumberSpace;
MaxScreenCols := MaxColWidth div DefaultMinColWidth;
GetMem(ColStart, MaxScreenCols);
if ColStart = nil then
begin
S.Error(stNoMemoryError, 0);
Exit;
end; {...if ColStart = nil }
OldCurrPos := CurrPos;
GetExtent(R);
Inc(R.A.Y, EmptyRowsAtTop);
Dec(R.B.Y, EmptyRowsAtBottom);
SetAreas(R);
Recalc(DisplayNo);
end; {...TSpreadSheet.Load }
procedure TSpreadSheet.LoadDelimited(FileName: PathStr);
var
F : Text;
S, SAdd : String;
V : Extended;
Counter, Code : Integer;
Pos : CellPos;
NotString : Boolean;
TempStream : TBufStream;
const
CR = CHR(13);
AL = CHR(10);
procedure CloseAndUpdateHash;
begin
Close(F);
FixOverWrite;
FindLastPos(LastPos);
DrawView;
LowMemSize := 4096 div 16;
TempStream.Done;
end; {...CloseAndUpdateHash }
begin
LowMemSize := 5088 div 16;
TempStream.Init(GLStringList^.Get(sTempFileName), stCreate, 1024);
Assign(F, FileName);
Reset(F);
Pos.Row := 0;
NotString := True;
while not Eof(F) do
begin
Readln(F, S);
Pos.Col := 1;
Inc(Pos.Row);
SAdd := '';
for Counter := 1 to Length(S) do
begin
if ( S[Counter] in [','] ) and NotString then
begin
if SAdd <> '' then
begin
case Pos.Col of
2..10,15 :
begin
if not AddCell(ClText, Pos, False, 0, ' '+SAdd) then
begin
CloseAndUpdateHash;
Exit;
end; {...if not AddCell }
end; {...case Pos.Col of 2..10, 15] }
1, 11..14, 16 :
begin
if SAdd[Length(SAdd)] = ' ' then
SAdd := Copy(SAdd, 1, Length(SAdd)-1);
val(SAdd, V, Code);
if not AddCell(ClValue, Pos, False, V, '') then
begin
CloseAndUpdateHash;
Exit;
end; {...if not AddCell }
end; {...case Pos.Col of 1, 11..14, 16 }
end; {...case Pos.Col }
SAdd := '';
end; {...if SAdd <> '' }
Inc(Pos.Col);
end; {...if ( S[Counter] in ',' ) and NotString }
if S[Counter] = '"' then
NotString := not NotString;
if not (S[Counter] in ['"','$',',']) then
SAdd := SAdd + S[Counter];
end; {...for Counter }
if SAdd <> '' then
begin
val(SAdd, V, Code);
if not AddCell(ClValue, Pos, False, V, '') then
begin
CloseAndUpdateHash;
Exit;
end; {...if not AddCell }
SAdd := '';
end; {...if SAdd <> '' }
end; {...while not Eof(F) }
CloseAndUpdateHash;
end; {...TSpreadSheet.LoadDelimited }
procedure TSpreadSheet.LoadHashTables(var S: TStream; AdjustAfter: CellPos;
RowAdjustment, ColAdjustment: Integer);
{ Loads all the hash tables from a stream }
var
TotalC, TotalF : LongInt;
TotalW : Word;
TotalHeaders : Word;
TotalUnlocked : LongInt;
begin
S.Read(TotalC, SizeOf(TotalC));
S.Read(TotalW, SizeOf(TotalW));
S.Read(TotalF, SizeOf(TotalF));
S.Read(TotalHeaders, 2);
S.Read(TotalUnlocked, SizeOf(TotalUnlocked));
if not CellHash.Init(CellHashStart(TotalC)) then
begin
S.Error(stNoMemoryError, 0);
Exit;
end; {...if not CellHash.Init(CellHashStart(TotalC)) }
if not WidthHash.Init(WidthHashStart, DefaultColWidth) then
begin
S.Error(stNoMemoryError, 0);
Exit;
end; {...if not WidthHash.Init(WidthHashStart, DefaultColWidth) }
if not FormatHash.Init then
begin
S.Error(stNoMemoryError, 0);
Exit;
end; {...if not FormatHash.Init }
if not OverWriteHash.Init(OverWriteHashStart) then
begin
S.Error(stNoMemoryError, 0);
Exit;
end; {...if not OverwriteHash.Init(OverwriteHashStart) }
if not ColHeadersHash.Init(ColHeadersHashStart) then
begin
S.Error(stNoMemoryError, 0);
Exit;
end; {...if not ColHeadersHash.Init(ColHeadersHashStart) }
if not UnlockedHash.Init then
begin
S.Error(stNoMemoryError, 0);
Exit;
end; {...if not UnlockedHash.Init }
CellHash.Load(S, TotalC, AdjustAfter, RowAdjustment, ColAdjustment);
if S.Status <> 0 then
Exit;
WidthHash.Load(S, TotalW);
if S.Status <> 0 then
Exit;
FormatHash.Load(S, TotalF);
if S.Status <> 0 then
Exit;
ColHeadersHash.Load(S, TotalHeaders);
if S.Status <> 0 then
Exit;
UnlockedHash.Load(S, TotalUnlocked);
end; {...TSpreadSheet.LoadHashTables }
procedure TSpreadSheet.LoadTablesFromTempFile(AdjustAfter: CellPos;
RowAdjustment, ColAdjustment: Integer);
{ Loads the hash tables from the temporal file in disk }
var
S : TDosStream;
begin
S.Init(GLStringList^.Get(sTempFileName), stOpenRead);
LoadHashTables(S, AdjustAfter, RowAdjustment, ColAdjustment);
S.Done;
end; {...TSpreadSheet.LoadTablesFromTempFile }
procedure TSpreadSheet.LocateCursorWithMouse(Event: TEvent);
{ Positions the highlight cursor in the position where the mouse was clicked }
var
ColScrPos : Byte;
OldPos : CellPos;
Counter : Integer;
Mouse : TPoint;
begin
MakeLocal(Event.Where, Mouse);
with ScreenBlock^ do
begin
if DisplayArea.PointInArea(Mouse.X, Mouse.Y) then
begin
CheckforDragging;
OldPos := CurrPos;
CurrPos.Row := YToRow(Mouse.Y);
if (not NoBlankArea) and (BlankArea.PointInArea(Mouse.X, Mouse.Y)) then
begin
CurrPos.Col := Min(Succ(Stop.Col), MaxCols);
DisplayAllCells;
DisplayCellData;
end { if }
else
begin
CurrPos.Col := XToCol(Mouse.X);
MoveCell(OldPos);
end; { else }
end; {...if DisplayArea.PointInArea(Mouse.X, Mouse.Y) }
end; {...with ScreenBlock^ }
end; {...TSpreadSheet.LocateCursorWithMouse }
procedure TSpreadSheet.MoveCell(OldPos: CellPos);
{ Moves the cursor from one place to another and extends the block if active }
begin
Desktop^.Lock;
ExtendCurrBlock(RedrawYes);
if ScreenBlock^.CellInBlock(OldPos) or
(OldPos.Col = Succ(ScreenBlock^.Stop.Col)) then
DisplayCell(OldPos);
DisplayCell(CurrPos);
DisplayCellData;
Desktop^.Unlock;
end; {...TSpreadSheet.MoveCell}
procedure TSpreadSheet.MoveCellBlock;
{ Activates the clipboard and sets it to indicate the block to be moved }
var
Block : PBlock;
begin
if BlockOn then
begin
if not CellsProtected(CurrBlock^) then
begin
New(Block, Init(CurrBlock^.Start));
Block^.Stop := CurrBlock^.Stop;
ToggleClipBoardOn(@Self, Block, BlockOn, opMove);
end {...if not CellsProtected(CurrBlock^) }
else
MessageBox(GLStringList^.Get(sCellsProtectedMsg), nil, mfInformation +
mfOKButton);
end {...if BlockOn}
else
begin
if not SheetProtected or (SheetProtected and
UnlockedHash.Search(CurrPos)) then
begin
New(Block, Init(CurrPos));
Block^.Stop := CurrPos;
ToggleClipBoardOn(@Self, Block, BlockOn, opMove);
end {...if not SheetProtected or ... }
else
MessageBox(GLStringList^.Get(sCellsProtectedMsg), nil, mfInformation +
mfOKButton);
end; {...if/else }
end; {...TSpreadSheet.MoveCellBlock}
{****************************************************************************}
{ TSpreadSheet.MoveDown }
{****************************************************************************}
procedure TSpreadSheet.MoveDown;
{ Moves the cursor one row down }
var
OldPos : CellPos;
begin
if CurrPos.Row < MaxRows then
begin
CheckForDragging;
Desktop^.Lock;
OldPos := CurrPos;
if GoToEnd then
CurrPos.Row := MaxRows
else
Inc(CurrPos.Row);
if TrackCursor then
UpdateScreenBlockDisplay
else
MoveCell(OldPos);
Desktop^.Unlock;
end; { if }
GoToEnd := True;
ToggleEnd;
end;
{****************************************************************************}
{ TSpreadSheet.MoveHome }
{****************************************************************************}
procedure TSpreadSheet.MoveHome;
{ Moves the cursor to the upper left corner of the spreadsheet }
var
OldPos : CellPos;
begin
Desktop^.Lock;
CheckforDragging;
OldPos := CurrPos;
InitCurrPos;
if TrackCursor then
UpdateScreenBlockDisplay
else
MoveCell(OldPos);
GoToEnd := True;
ToggleEnd;
Desktop^.Unlock;
end;
{****************************************************************************}
{ TSpreadSheet.MoveLeft }
{****************************************************************************}
procedure TSpreadSheet.MoveLeft;
{ Moves the cursor one column left }
var
OldPos : CellPos;
begin
if CurrPos.Col > 1 then
begin
CheckForDragging;
Desktop^.Lock;
OldPos := CurrPos;
if GoToEnd then
CurrPos.Col := 1
else
Dec(CurrPos.Col);
if TrackCursor then
UpdateScreenBlockDisplay
else
MoveCell(OldPos);
Desktop^.Unlock;
end; { if }
GoToEnd := True;
ToggleEnd;
end;
procedure TSpreadSheet.MovePgDown;
{ Moves the cursor one full page down }
var
OldPos : CellPos;
begin
if CurrPos.Row < MaxRows then
begin
CheckForDragging;
Desktop^.Lock;
OldPos := CurrPos;
TrackCursor;
CurrPos.Row := Min(MaxRows, CurrPos.Row + TotalRows);
SetScreenRowStart(Min(MaxRows, Succ(ScreenBlock^.Stop.Row)));
UpdateScreenBlockDisplay;
Desktop^.Unlock;
end; {...if CurrPos.Row < MaxRows }
end; {...TSpreadSheet.MovePgDown }
procedure TSpreadSheet.MovePgLeft;
{ Moves the cursor one full page left }
var
OldPos : CellPos;
TotalCols : Byte;
begin
if CurrPos.Col > 1 then
begin
CheckForDragging;
Desktop^.Lock;
OldPos := CurrPos;
TotalCols := Succ(ScreenBlock^.Stop.Col - ScreenBlock^.Start.Col);
SetScreenColStop(Max(1, Pred(ScreenBlock^.Start.Col)));
CurrPos.Col := Max(ScreenBlock^.Start.Col, LongInt(CurrPos.Col) -
TotalCols);
UpdateScreenBlockDisplay;
Desktop^.Unlock;
end; {...if CurrPos.Col > 1 }
end; {...TSpreadSheet.MovePgLeft }
procedure TSpreadSheet.MovePgRight;
{ Moves the cursor one full page right }
var
OldPos : CellPos;
TotalCols : Byte;
begin
if CurrPos.Col < MaxCols then
begin
CheckForDragging;
Desktop^.Lock;
OldPos := CurrPos;
TotalCols := Succ(ScreenBlock^.Stop.Col - ScreenBlock^.Start.Col);
SetScreenColStart(Min(MaxCols, Succ(ScreenBlock^.Stop.Col)));
CurrPos.Col := Min(ScreenBlock^.Stop.Col, LongInt(CurrPos.Col) +
TotalCols);
UpdateScreenBlockDisplay;
Desktop^.Unlock;
end; {...if CurrPos.Col < MaxCols }
end; {...TSpreadSheet.MovePgRight }
procedure TSpreadSheet.MovePgUp;
var
OldPos, NewPos : CellPos;
begin
if CurrPos.Row > 1 then
begin
CheckForDragging;
Desktop^.Lock;
OldPos := CurrPos;
TrackCursor;
CurrPos.Row := Max(1, LongInt(CurrPos.Row) - TotalRows);
SetScreenRowStop(Max(1, Pred(ScreenBlock^.Start.Row)));
UpdateScreenBlockDisplay;
Desktop^.Unlock;
end; {...if CurrPos.Row > 1 }
end; {...TSpreadSheet.MovePgUp }
{****************************************************************************}
{ TSpreadSheet.MoveRight }
{****************************************************************************}
procedure TSpreadSheet.MoveRight;
{ Moves the cursor one column to the right }
var
OldPos : CellPos;
begin
if CurrPos.Col < MaxCols then
begin
CheckForDragging;
Desktop^.Lock;
OldPos := CurrPos;
if GoToEnd then
CurrPos.Col := MaxCols
else
Inc(CurrPos.Col);
if TrackCursor then
UpdateScreenBlockDisplay
else
MoveCell(OldPos);
Desktop^.Unlock;
end; { if }
GoToEnd := True;
ToggleEnd;
end;
{****************************************************************************}
{ TSpreadSheet.MoveUp }
{****************************************************************************}
procedure TSpreadSheet.MoveUp;
{ Moves the cursor one row up }
var
OldPos : CellPos;
begin
if CurrPos.Row > 1 then
begin
CheckForDragging;
Desktop^.Lock;
OldPos := CurrPos;
if GoToEnd then
CurrPos.Row := 1
else
Dec(CurrPos.Row);
if TrackCursor then
UpdateScreenBlockDisplay
else
MoveCell(OldPos);
Desktop^.Unlock;
end; { if }
GoToEnd := True;
ToggleEnd;
end;
function TSpreadSheet.OverwriteHashStart: BucketRange;
{ Returns the initial number of buckest for the OverwriteHash }
begin
OverwriteHashStart := 10;
end; {...TSpreadSheet.OverwriteHashStart}
function TSpreadSheet.Parser: PParserObject;
{ Returns a pointer to the parser to be used }
begin
Parser := StandardParser;
end; {...TSpreadSheet.Parser }
procedure TSpreadSheet.PasteBlock(DestBlock: TBlock; Formulas: Word);
{ Moves or copies a block of cells to a new position }
var
Deleted, Good : Boolean;
DestPos, SrcPos : CellPos;
FormOp : FormulaOps;
CellPtr, CP : PCell;
ColChange, RowChange : ShortInt;
SrcStartCol, DestStartCol : Word;
const
CopyColLitBit = $01;
CopyRowLitBit = $02;
begin
Good := True;
with ClipBoard do
begin
if SameCellPos(BlockToCopy^.Start, BlockToCopy^.Stop) then
{ A single cell will be copied to a block of cells }
begin
SrcPos := BlockToCopy^.Start;
DestPos := DestBlock.Start;
if DestBlock.CellInBlock(SrcPos) and
(SourceSpreadSheet = @Self) then
{ if the source cell is in the destination block then
delete it from the cell hash to avoid storing the same
cell twice at the same position }
CellHash.Delete(SrcPos, CellPtr)
else
CellPtr := SourceCellHash^.Search(SrcPos);
if CellPtr <> Empty then
begin
SetChanged(ModifiedYes);
while Good and (DestPos.Row <= DestBlock.Stop.Row) do
begin
DestPos.Col := DestBlock.Start.Col;
while Good and (DestPos.Col <= DestBlock.Stop.Col) do
begin
with CellPtr^ do
begin
{ Delete the current cell in the destination position }
DeleteCell(DestPos, Deleted);
{ Add a copy of the source cell in the new position }
Good := AddCell(CellType, DestPos, HasError, CurrValue,
CopyString);
if not Good then
begin
if DestBlock.CellInBlock(SrcPos) and
(SourceSpreadSheet = @Self) then
{ if the cell was not added to the cell hash table
because of a low memory error, and the source cell was
in the destination block, then add the source cell
to the table at the destination position. This can be
done because the source cell already has memory
allocated and it does not use more memory when added to
the hash table }
begin
CellPtr^.Loc := DestPos;
CellHash.Add(CellPtr)
end; { if }
end; { if }
{ Determine if cell addresses in formulas should be modified }
CP := CellHash.Search(DestPos);
if (CP <> nil) and CP^.ShouldUpdate then
begin
if (Formulas and CopyColLitBit) = 0 then
{ Formula column addresses must be modified }
begin
if DestPos.Col >= SrcPos.Col then
{ The column addresses must be increased }
FormOp := opInsert
else
{ The column addresses must be decreased }
FormOp := opDelete;
FixFormulaCol(CP, FormOp, 0, Abs(LongInt(DestPos.Col) -
LongInt(SrcPos.Col)), MaxCols, MaxRows);
end; {...if (Formulas and CopyColLitBit) = 0 }
if (Formulas and CopyRowLitBit) = 0 then
{ Formula row addresses must be modified }
begin
if DestPos.Row >= SrcPos.Row then
{ The row addresses must be increased }
FormOp := opInsert
else
{ The row addresses must be decreased }
FormOp := opDelete;
FixFormulaRow(CP, FormOp, 0, Abs(LongInt(DestPos.Row) -
LongInt(SrcPos.Row)), MaxCols, MaxRows);
end; {...if (Formulas and CopyRowLitBit) = 0 }
end; {...if (CP <> nil) and CP^.ShouldUpdate }
end; {...with CellPtr^}
Inc(DestPos.Col);
end; {...while Good and (DestPos.Col <= DestBlock.Stop.Col) }
Inc(DestPos.Row);
end; {...while Good and (DestPos.Row <= DestBlock.Stop.Row) }
if DestBlock.CellInBlock(SrcPos) and (SourceSpreadSheet = @Self) then
{ Discard the original cell, since a new copy of it was added in
the same position }
Dispose(CellPtr, Done)
else if (Operation = opMove) and Good then
{ if the source cell was in the destination block, and it was
a move operation, then delete the source cell }
SourceSpreadSheet^.DeleteCell(SrcPos, Deleted);
end; {...if CellPtr <> Empty }
end {...if SameCellPos(BlockToCopy^.Start, BlockToCopy^.Stop) }
else
begin
if not (SameCellPos(BlockToCopy^.Start, DestBlock.Start) and
(SourceSpreadSheet = @Self)) then
{ Continue only after verifying that a block is not going to be
copied into itself }
begin
SetChanged(ModifiedYes);
if (BlockToCopy^.Start.Col < DestBlock.Start.Col) and
(SourceSpreadSheet = @Self) then
{ if the possibility exists that the blocks may overlap in such
a way that cells of the source block are overwritten by the
cells in the destination block before they are copied, then
copy the blocks backwards }
begin
ColChange := -1;
SrcPos.Col := BlockToCopy^.Stop.Col;
DestPos.Col := DestBlock.Stop.Col;
end {...if (BlockToCopy^.Start.Col < DestBlock.Start.Col) }
else
begin
ColChange := 1;
SrcPos.Col := BlockToCopy^.Start.Col;
DestPos.Col := DestBlock.Start.Col;
end; {...if/else }
if (BlockToCopy^.Start.Row < DestBlock.Start.Row) and
(SourceSpreadSheet = @Self) then
{ if the possibility exists that the blocks may overlap in such
a way that cells of the source block are overwritten by the
cells in the destination block before they are copied, then
copy the blocks backwards }
begin
RowChange := -1;
SrcPos.Row := BlockToCopy^.Stop.Row;
DestPos.Row := DestBlock.Stop.Row;
end {...if (BlockToCopy^.Start.Row < DestBlock.Start.Row) }
else
begin
RowChange := 1;
SrcPos.Row := BlockToCopy^.Start.Row;
DestPos.Row := DestBlock.Start.Row;
end; {...if/else }
{ Assign values to the SrcStartCol and DestStartCol which indicate
the column of the first cell that has to be copied everytime a
new row is selected for copying }
SrcStartCol := SrcPos.Col;
DestStartCol := DestPos.Col;
with BlockToCopy^ do
begin
while Good and ((SrcPos.Row <= Stop.Row) and
(SrcPos.Row >= Start.Row)) and (DestPos.Row <= MaxRows) do
begin
SrcPos.Col := SrcStartCol;
DestPos.Col := DestStartCol;
while Good and ((SrcPos.Col <= Stop.Col) and
(SrcPos.Col >= Start.Col)) and (DestPos.Col <= MaxCols) do
begin
CellPtr := SourceCellHash^.Search(SrcPos);
CellHash.Delete(DestPos, CP);
if CP <> nil then
Dispose(CP, Done);
if (CellPtr <> Empty) and (CellPtr <> nil) then
begin
with CellPtr^ do
begin
Good := AddCell(CellType, DestPos, HasError, CurrValue,
CopyString);
if Good then
begin
CellPtr := CellHash.Search(DestPos);
if CellPtr^.ShouldUpdate then
begin
if (Formulas and CopyColLitBit) = 0 then
begin
if DestPos.Col >= SrcPos.Col then
FormOp := opInsert
else
FormOp := opDelete;
FixFormulaCol(CellPtr,FormOp, 0,
Abs(LongInt(DestPos.Col) - LongInt(SrcPos.Col)),
MaxCols, MaxRows);
end; {...if (Fomulas and CopyColLitBit) = 0 }
if (Formulas and CopyRowLitBit) = 0 then
begin
if DestPos.Row >= SrcPos.Row then
FormOp := opInsert
else
FormOp := opDelete;
FixFormulaRow(CellPtr, FormOp, 0,
Abs(LongInt(DestPos.Row) - LongInt(SrcPos.Row)),
MaxCols, MaxRows);
end; {...if (Formulas and CopyRowLitBit) = 0 }
end; {...if CellPtr^.ShouldUpdate }
end; {...if Good }
end; {...with CellPtr^ }
end; {...if (CellPtr <> Empty) and (CellPtr <> nil) }
if (Operation = opMove) and Good then
begin
SourceCellHash^.Delete(SrcPos, CP);
if CP <> nil then
Dispose(CP, Done);
end; {...if (Operation = opMove) and Good }
Inc(DestPos.Col, ColChange);
Inc(SrcPos.Col, ColChange);
end; {...while Good and ((SrcPos.Col <= Stop.Col) and ... }
Inc(DestPos.Row, RowChange);
Inc(SrcPos.Row, RowChange);
end; {...while Good and ((SrcPos.Row <= Stop.Row) and ... }
end; {...with BlockToCopy^ }
end; {...if not SameCellPos(BlockToCopy^.Start, DestBlock.Start) ... }
end; {...if/else }
end; {...with ClipBoard }
end; {...TSpreadSheet.PasteBlock }
procedure TSpreadSheet.PasteCellBlock;
{ Copies a block from the source location to the current position }
var
Dialog : PDialog;
Block : TBlock;
begin
with ClipBoard do
begin
{ if the clipboard is active, then continue with the paste operation }
if Active then
begin
{ Determine the destination block }
if BlockOn then
Block.Init(CurrBlock^.Start)
else
Block.Init(CurrPos);
if SameCellPos(BlockToCopy^.Start, BlockToCopy^.Stop) then
{ if its only one cell that will be copied in a block of cells then
the destination block will be the currently selected block (if
there is no block selected, the destination block will be the
current cell }
begin
if BlockOn then
Block.Stop := CurrBlock^.Stop
end {...if SameCellPos(BlockToCopy^.Start, BlockToCopy^.Stop) }
else
{ if a block of cells will be copied, then the destination block will
have the same dimensions as the original block of cells }
begin
Inc(Block.Stop.Col, BlockToCopy^.Stop.Col - BlockToCopy^.Start.Col);
Inc(Block.Stop.Row, BlockToCopy^.Stop.Row - BlockToCopy^.Start.Row);
end; {...if/else }
{ Verifies that no protected cells are being deleted or overwritten }
if SheetProtected then
begin
{ Verifies that there are no protected cells in the destination
block that could be overwritten }
if CellsProtected(Block) then
begin
MessageBox(GLStringList^.Get(sCellsProtectedMsg), nil,
mfInformation + mfOKButton);
Exit;
end ; {...if CellsProtected(Block) }
end; {...if SheetProtected }
{ Execute the dialog requesting instructions on whether to update or
not the formulas (if any) in the block to be copied or moved }
Dialog := PDialog(GLResFile^.Get('FormulasDialog'));
if Application^.ValidView(Dialog) <> nil then
begin
EraseMessage;
if Desktop^.ExecView(Dialog) <> cmCancel then
begin
Dialog^.GetData(RCopyFormulas);
MessageDialog := PDialog(GLResFile^.Get('UpdatingTablesDialog'));
if Application^.ValidView(MessageDialog) <> nil then
Desktop^.Insert(MessageDialog)
else
begin
MessageDialog := nil;
Exit;
end; { else }
PasteBlock(Block, RCopyFormulas.CopyFormulas);
if MessageDialog <> nil then
begin
Desktop^.Delete(Dialog);
Dispose(MessageDialog, Done);
MessageDialog := nil;
end; { if }
if (SourceSpreadSheet <> @Self) and (SourceSpreadSheet <> nil) then
SourceSpreadSheet^.DisplayAllCells;
DisplayAllCells;
ToggleClipBoardOff;
end; {...if Desktop^.ExecView(Dialog) <> cmCancel }
Dispose(Dialog, Done);
end; {...if Application^.ValidView(Dialog) <> nil }
end; {...if Active }
end; {...with ClipBoard }
end; {...TSpreadSheet.PasteCellBlock }
procedure TSpreadSheet.Print;
{ Prints the spreadsheet }
var
Dialog : PDialog;
Error, { Is set to true whenever an error ocurrs }
Finished : Boolean; { Is set to true when the print job is finished }
FileString : PathStr;
OutputFile : Text; { File used for output }
PageH, { Horizontal position of the page being printed }
PageV, { Vertical position of the page being printed }
SelectedCommand, { Stores the result from the message box dialogs }
StartCol, { Starting column of the page being printed }
StartRow : Word; { Starting row of the page being printed }
TopM, BottomM, LeftM, { Used to store the }
RightM, PageR, PageCols, { values entered }
ColsN, ColsC : Byte; { in the Print Dialog }
Code : Integer; { Return code of the val function }
function CheckForEscape: Boolean;
{ Checks the event buffer to see if ESC has been pressed to
cancel the print job }
var
Event : TEvent;
begin
CheckForEscape := False;
GetEvent(Event);
if Event.What = evKeyDown then
if Event.KeyCode = kbEsc then
begin
{ if ESC was pressed, delete the 'Printing...' dialog
and prompt the user for confirmation }
Desktop^.Delete(Dialog);
if MessageBox(GLStringList^.Get(sCancelPrintJob), nil,
mfError + mfYesButton + mfNoButton) = cmYes then
CheckForEscape := True
else
Desktop^.Insert(Dialog);
end {...if Event.KeyCode = kbEsc }
end; {...CheckForEscape }
function PrintChar(C: String): Boolean;
{ Prints a code to the assigned device without a sending a CR }
begin
PrintChar := True;
repeat
if CheckForEscape then
begin
PrintChar := False;
Exit;
end; {...if CheckForEscape }
Error := False;
{$I-}
Write(OutputFile, C);
{$I+}
if IOResult <> 0 then
begin
Error := True;
if FileString = DefaultPrinterName then
begin
Desktop^.Delete(Dialog);
SelectedCommand := MessageBox(
GLStringList^.Get(sPrinterPrintErrorMsg), nil, mfError +
mfYesButton + mfNoButton);
if SelectedCommand = cmNo then
PrintChar := False
else
{ Since the print job will continue, display again
the 'Printing...' dialog }
Desktop^.Insert(Dialog);
end {...if FileString = DefaultPrinterName }
else
begin
SelectedCommand := MessageBox(
GLStringList^.Get(sFilePrintErrorMsg), nil, mfError +
mfYesButton + mfNoButton);
if SelectedCommand = cmNo then
PrintChar := False
else
Desktop^.Insert(Dialog);
end; {...if/else }
end; {...if IOResult <> 0 }
until not Error or (SelectedCommand = cmNo);
end; {...PrintChar }
function PrintString(S: String): Boolean;
{ Prints a string to the assigned device }
begin
PrintString := True;
repeat
if CheckForEscape then
begin
PrintString := False;
Exit;
end; {...if CheckForEscape }
Error := False;
{$I-}
Writeln(OutputFile, S);
{$I+}
if IOResult <> 0 then
begin
Error := True;
if FileString = DefaultPrinterName then
begin
SelectedCommand := MessageBox(
GLStringList^.Get(sPrinterPrintErrorMsg), nil, mfError +
mfYesButton + mfNoButton);
if SelectedCommand = cmNo then
PrintString := False
else
Desktop^.Insert(Dialog);
end {...if FileString = DefaultPrinterName }
else
begin
SelectedCommand := MessageBox(
GLStringList^.Get(sFilePrintErrorMsg), nil, mfError +
mfYesButton + mfNoButton);
if SelectedCommand = cmNo then
PrintString := False
else
Desktop^.Insert(Dialog);
end; {...if/else }
end; {...if IOResult <> 0}
until not Error or (SelectedCommand = cmNo);
end; {...PrintString }
function RowStartString(Row: Word): String;
{ Returns the row string to be printed at the beginning of a line }
begin
RowStartString := '';
with RPrint do
begin
if PrintRows <> 0 then
begin
if ((PrintRows = 1) and (PageH = 1)) or (PrintRows = 2) then
begin
RowStartString := LeftJustStr(RowToString(Row), RowNumberSpace);
RowStartString[RowNumberSpace] := '│';
end; {...if ((PrintRows = 1) and (PageH = 1)) or... }
end; {...if PrintRows <> 0 }
end; {...with RPrint }
end; {...RowStartString }
function PrintPage: Boolean;
{ Prints one page of the spreadsheet }
var
Color : Byte; { Simply used to fill the list of parameters for
the CellToFString method }
Cols, Counter, Rows : Byte;
Pos : CellPos;
S : String;
const
OutlineBit = $01;
BoldBit = $02;
begin
PrintPage := False;
with RPrint, PrinterConfigRec do
begin
{ Top margin }
for Counter := 1 to TopM do
if not PrintString('') then
Exit;
{ Determine the number of rows that will fit in the page }
Rows := Min((PageR - TopM - BottomM), Succ(MaxRows - StartRow));
{ One row will be used if the column headers will be printed }
if PrintColumns in [1,2] then
Dec(Rows);
{ Determine the number of columns that can fit in a page }
Cols := 0;
Counter := Length(RowStartString(StartRow));
while Counter <= PageCols do
begin
Inc(Counter, ColWidth(Cols + StartCol));
Inc(Cols);
end; {...while Counter <= PageCols }
Dec(Cols);
Cols := Min(Cols, Succ(MaxCols - StartCol));
if ((PrintColumns = 1) and (PageV = 1)) or (PrintColumns = 2) then
{ Print the column headers if requested }
begin
S := FillString(Length(RowStartString(StartRow)), ' ');
for Counter := StartCol to Pred(StartCol + Cols) do
S := S + CenterStr(ColumnToString(Counter), ColWidth(Counter));
if not PrintChar(PrinterUnderlineOnCode) then
Exit;
if (Other and BoldBit) <> 0 then
if not PrintChar(PrinterBoldOnCode) then
Exit;
if not PrintString(S) then
Exit;
if (Other and BoldBit) <> 0 then
if not PrintChar(PrinterBoldOffCode) then
Exit;
if not PrintChar(PrinterUnderlineOffCode) then
Exit;
end; {...if ((PrintColumns = 1) and (PageV = 1))... }
{ Print the data }
for Pos.Row := StartRow to Pred(StartRow + Rows) do
begin
S := RowStartString(Pos.Row);
if S <> '' then
{ Print the row numbers }
begin
if (Other and BoldBit) <> 0 then
if not PrintChar(PrinterBoldOnCode) then
Exit;
if not PrintChar(S) then
Exit;
if (Other and BoldBit) <> 0 then
if not PrintChar(PrinterBoldOffCode) then
Exit;
S := '';
end; {...if S <> '' }
for Pos.Col := StartCol to Pred(StartCol + Cols) do
S := S + CellToFString(Pos, Color);
if not PrintString(S) then
Exit;
end; {...for Pos.Row }
Inc(StartCol, Cols);
if (StartCol > LastPos.Col) or (StartCol = 0) then
begin
Inc(StartRow, Rows);
if (StartRow > LastPos.Row) or (StartRow = 0) then
Finished := True
else
begin
Inc(PageV);
PageH := 1;
StartCol := 1;
end; {...if/else }
end {...if (StartCol > LastPos.Col) or (StartCol = 0) }
else
Inc(PageH);
if not PrintChar(Chr(FF)) then
Exit;
end; {...with RPrint, PrinterConfigRec }
PrintPage := True;
end; {...PrintPage }
procedure EndPrintJob;
{ Does all the necessary clean up when finishing a print job }
begin
Close(OutputFile);
InitSysError;
end; {...EndPrintJob }
begin
Dialog := PDialog(GLResFile^.Get('PrintDialog'));
Dialog^.SetData(RPrint);
if Application^.ValidView(Dialog) <> nil then
begin
if Desktop^.ExecView(Dialog) <> cmCancel then
Dialog^.GetData(RPrint)
else
begin
Dispose(Dialog, Done);
Exit;
end; {...if/else }
end {...if Application^.ValidView(Dialog) <> nil }
else
Exit;
Dispose(Dialog, Done);
with RPrint, PrinterConfigRec do
begin
if PrintTo = 0 then
FileString := DefaultPrinterName
else
begin
Dialog := PFileDialog(GLResFile^.Get('PrintToDialog'));
if Application^.ValidView(Dialog) <> nil then
begin
if Desktop^.ExecView(Dialog) <> cmCancel then
Dialog^.GetData(FileString)
else
begin
Dispose(Dialog, Done);
Exit;
end; {...if/else }
end {...if Application^.ValidView(Dialog) <> nil }
else
Exit;
Dispose(Dialog, Done);
end; {...if/else }
{ Disables Turbo Vision's system error handler to be able to handle
print errors differently }
DoneSysError;
repeat
Error := False;
{$I-}
Assign(OutputFile, FileString);
Rewrite(OutputFile);
{$I+}
if IOResult <> 0 then
{ if the file could not be opened, prompt the user wether to
continue with or cancel the print job }
begin
Error := True;
SelectedCommand := MessageBox(GLStringList^.Get(sPrintInitErrorMsg),
nil, mfYesButton + mfNoButton);
if SelectedCommand = cmNo then
begin
EndPrintJob;
Exit;
end; {...if SelectedCommand = cmNo }
end; {...if IOResult <> 0 }
until not Error;
{ Convert to numbers the values entered in the 'Print Dialog' }
val(TopMargin, TopM, Code);
val(BottomMargin, BottomM, Code);
val(LeftMargin, LeftM, Code);
val(RightMargin, RightM, Code);
val(PageRows, PageR, Code);
val(NormalCols, ColsN, Code);
val(CondensedCols, ColsC, Code);
{ Determine the number of columns available for printing }
if PrintSize = 1 then
begin
if not PrintChar(PrinterCondensedOnCode) then
begin
EndPrintJob;
Exit;
end; {...if not PrintChar(PrinterCondensedOnCode) }
PageCols := ColsC;
end {...if PrintSize = 1}
else
PageCols := ColsN;
PageV := 1;
PageH := 1;
StartCol := 1;
StartRow := 1;
Finished := False;
{ Display a dialog to indicate the file is being printed }
Dialog := PDialog(GLResFile^.Get('PrintingDialog'));
if Application^.ValidView(Dialog) <> nil then
Desktop^.Insert(Dialog)
else
begin
if Dialog <> nil then
Dispose(Dialog, Done);
EndPrintJob;
Exit;
end; {...if/else }
repeat
if not PrintPage then
begin
EndPrintJob;
{ It is not necessary to delete the dialog from the desktop
since the dialog is deleted before prompting the user
for cancelation }
Dispose(Dialog, Done);
Exit;
end; {...if not PrintPage }
until Finished;
if not PrintChar(PrinterCondensedOffCode) or
not PrintChar(PrinterUnderlineOffCode) then
begin
EndPrintJob;
Desktop^.Delete(Dialog);
Dispose(Dialog, Done);
Exit;
end; {...if not PrintChar(PrinterCondensedOffCode) or ... }
EndPrintJob;
Desktop^.Delete(Dialog);
Dispose(Dialog, Done);
end; {...with RPrint, PrinterConfigRec }
end; {...TSpreadSheet.Print }
procedure TSpreadSheet.Recalc(Display: Boolean);
{ Recalculates all the values that need to be recalculated }
var
Pos : CellPos;
procedure DoUpdate;
var
NewPos : CellPos;
CellPtr : PCell;
CellsOverWritten : Word;
FormulaStr : PString;
begin
with CellHash do
begin
CellPtr := Search(Pos);
if CellPtr^.ShouldUpdate then
begin
with PFormulaCell(CellPtr)^ do
begin
FormulaStr := NewStr(Formula.ToString);
Parser^.Init(@CellHash, FormulaStr, MaxCols, MaxRows);
Parser^.Parse;
DisposeStr(FormulaStr);
Value := Parser^.ParseValue;
Error := Parser^.ParseError;
SetChanged(ModifiedYes);
CellsOverWritten := CellPtr^.OverWritten(CellHash, FormatHash,
WidthHash, LastPos, MaxCols, GetColWidth, DisplayFormulas);
if OverWriteHash.Change(CellPtr, CellsOverWritten) and Display and
(CellPtr^.Loc.Col + CellsOverWritten >=
ScreenBlock^.Start.Col) then
begin
NewPos := CellPtr^.Loc;
for NewPos.Col := CellPtr^.Loc.Col to ScreenBlock^.Stop.Col do
begin
if ScreenBlock^.CellInBlock(NewPos) then
DisplayCell(NewPos);
end; {...for NewPos.Col }
end; {...if OverWriteHash.Change(CellPtr, CellsOverWritten) ... }
end; {...with PFormulaCell(CellPtr)^ }
end; {...if CellPtr^.ShouldUpdate }
end; {...with CellHash }
end; {...DoUpdate }
begin
DisplayMessage(GLStringList^.Get(sRecalcMsg));
for Pos.Row := 1 to LastPos.Row do
for Pos.Col := 1 to LastPos.Col do
DoUpdate;
for Pos.Row := LastPos.Row downto 1 do
for Pos.Col := LastPos.Col downto 1 do
DoUpdate;
EraseMessage;
end; {...TSpreadSheet.Recalc }
function TSpreadsheet.RowToY(Row : Integer) : Byte;
{ Returns the screen position of a particular row }
begin
RowToY := (Row - ScreenBlock^.Start.Row) + DisplayArea.UpperLeft.Row ;
end; {...TSpreadSheet.RowToY }
function TSpreadSheet.SameCellPos(P1, P2 : CellPos) : Boolean;
{ Returns true if two positions are the same }
begin
SameCellPos := Compare(P1, P2, SizeOf(CellPos));
end; {...TSpreadSheet.SameCellPos }
{****************************************************************************}
{ TSpreadSheet.SetFormat }
{****************************************************************************}
procedure TSpreadSheet.SetFormat(Block: TBlock; DecimalPlaces: Byte;
Justification, NumberFormat: Word; CurrencyChar: Char);
var
Format: FormatType;
begin
Format := DecimalPlaces + (Justification shl JustShift) + (NumberFormat
shl NumberFormatShift) + (Ord(CurrencyChar) shl CurrencyShift);
if not FormatHash.Add(Block.Start, Block.Stop, Format) then
Exit;
FixBlockOverwrite(Block);
end;
function TSpreadSheet.SelectColumn(var Event: TEvent): Boolean;
{ Marks a complete column as selected }
var
Pos : CellPos;
SelectedCol : Integer;
Block : TBlock;
Mouse : TPoint;
begin
MakeLocal(Event.Where, Mouse);
if ColArea.PointInArea(Mouse.X, Mouse.Y) then
begin
ClearCurrBlock;
SelectedCol := XToCol(Mouse.X);
if SelectedCol = 0 then
Exit;
Pos := CurrPos;
CurrPos.Row := 1;
CurrPos.Col := SelectedCol;
ToggleBlockOn;
CurrPos.Row := ScreenBlock^.Start.Row;
if ScreenBlock^.CellInBlock(Pos) then
MoveCell(Pos);
Pos.Row := MaxRows;
Pos.Col := SelectedCol;
CurrBlock^.Stop := Pos;
Block.Start := CurrBlock^.Start;
Pos.Row := ScreenBlock^.Stop.Row;
Block.Stop := Pos;
DisplayBlock(Block);
DisplayCellData;
ClearEvent(Event);
SelectColumn := True;
end {...if ColArea.PointInArea(Mouse.X, Mouse.Y) }
else
SelectColumn := False;
end; {...TSpreadSheet.SelectColumn }
procedure TSpreadSheet.ScrollDraw;
{ Redraws the spreadsheet whenever the scrollbar changes }
var
Redraw : Boolean;
D : TPoint;
begin
Desktop^.Lock;
if HScrollBar <> nil then
D.X := HScrollBar^.Value
else
D.X := 0;
if VScrollBar <> nil then
D.Y := VScrollBar^.Value
else
D.Y := 0;
if D.X <> Delta.X then
begin
with PlimScrollBar(HScrollBar)^, ScreenBlock^ do
begin
if (Abs(Change) = 1) and not KeyPressed then
begin
if Abs(Change) = Change then
begin
if Stop.Col < MaxCols then
begin
Inc(Stop.Col);
SetScreenColStop(Stop.Col);
Redraw := True;
end {...if Stop.Col < MaxCols }
else
SetValue(Delta.X);
end {...if Abs(Change) = Change }
else
begin
if Start.Col > 1 then
begin
Dec(Start.Col);
SetScreenColStart(Start.Col);
Redraw := True;
end {...if Start.Col > 1 }
else
SetValue(Delta.X);
end; {...if/else }
if Redraw then
begin
SetBlankArea;
DisplayCols;
DisplayAllCells;
DisplayCellData;
if Value <> Start.Col then
begin
Value := Start.Col;
HScrollBar^.DrawView;
end; {...if Value <> Start.Col }
Delta.X := Value;
end; {...if Redraw }
end {...if (Abs(Change) = 1) and not KeyPressed }
else if (Abs(Change) = PgStep) and not KeyPressed then
begin
if Abs(Change) = Change then
begin
if Stop.Col < MaxCols then
begin
Start.Col := Succ(Stop.Col);
SetScreenColStart(Start.Col);
Redraw := True;
end {...if Stop.Col < MaxCols }
else
SetValue(Delta.X);
end {...if Abs(Change) = Change }
else
begin
if Start.Col > 1 then
begin
Stop.Col := Pred(Start.Col);
SetScreenColStop(Stop.Col);
Redraw := True;
end {...if Start.Col > 1 }
else
SetValue(Delta.X);
end; {...if/else }
if Redraw then
begin
SetBlankArea;
DisplayCols;
DisplayAllCells;
DisplayCellData;
if Value <> Start.Col then
begin
Value := Start.Col;
HScrollBar^.DrawView;
end; {...if Value <> Start.Col }
Delta.X := Value;
end; {...if Redraw }
end {...else if (Abs(Change) = PgStep) and not KeyPressed }
else
begin
if (Value <= MaxCols) and (Value >= 1) then
begin
Start.Col := Value;
if KeyPressed then
ExtendCurrBlock(RedrawNo);
SetScreenColStart(Start.Col);
SetBlankArea;
DisplayCols;
DisplayAllCells;
DisplayCellData;
Delta.X := Value;
end {...if (Value <= MaxCols) and (Value >= 1) }
else
SetValue(Delta.X);
end; {...if/else }
end; {...with PLimScrollBar(HScrollBar^), ScreenBlock^ }
end; {...if D.X <> Delta.X }
if D.Y <> Delta.Y then
begin
with PLimScrollBar(VScrollBar)^, ScreenBlock^ do
begin
if (Abs(Change) = 1) and not KeyPressed then
begin
if Abs(Change) = Change then
begin
if Stop.Row < MaxRows then
begin
Inc(Stop.Row);
SetScreenRowStop(Stop.Row);
Redraw := True;
end {...if Stop.Row < MaxRows }
else
SetValue(Delta.Y);
end {...if Abs(Change) = Change }
else
begin
if Start.Row > 1 then
begin
Dec(Start.Row);
SetScreenRowStart(Start.Row);
Redraw := True;
end {...if Start.Row > 1 }
else
SetValue(Delta.Y);
end; {...if/else }
if Redraw then
begin
DisplayRows;
DisplayAllCells;
DisplayCellData;
if Value <> Start.Row then
begin
Value := Start.Row;
VScrollBar^.DrawView;
end; {...if Value <> Start.Row }
Delta.Y := Value;
end; {...if Redraw }
end {...if (Abs(Change) = 1) and not KeyPressed }
else if (Abs(Change) = PgStep) and not KeyPressed then
begin
if Abs(Change) = Change then
begin
if Stop.Row < MaxRows then
begin
Start.Row := Start.Row + TotalRows;
if Start.Row > MaxRows then
Start.Row := MaxRows;
SetScreenRowStart(Start.Row);
Redraw := True;
end {...if Stop.Row < MaxRows }
else
SetValue(Delta.Y);
end {...if Abs(Change) = Change }
else
begin
if Start.Row > 1 then
begin
Start.Row := Start.Row - TotalRows;
if Start.Row < 1 then
Start.Row := 1;
SetScreenRowStart(Start.Row);
Redraw := True;
end {...if Start.Row > 1 }
else
SetValue(Delta.Y);
end; {...if/else }
if Redraw then
begin
DisplayRows;
DisplayAllCells;
DisplayCellData;
if Value <> Start.Row then
begin
Value := Start.Row;
VScrollBar^.DrawView;
end; {...if Value <> Start.Row }
Delta.Y := Value;
end; {...if Redraw }
end {...else if (Abs(Change) = PgStep) and not KeyPressed }
else
begin
if (Value <= MaxRows) and (Value >= 1) then
begin
Start.Row := Value;
if KeyPressed then
ExtendCurrBlock(RedrawNo);
SetScreenRowStart(Start.Row);
DisplayRows;
DisplayAllCells;
DisplayCellData;
Delta.Y := Value;
end {...if (Value <= MaxRows) and (Value >= 1) }
else
SetValue(Delta.Y);
end; {...if/else }
end; {...with PLimScrollBar(VScrollBar)^, ScreenBlock^ }
end; {...if D.Y <> Delta.Y }
Desktop^.Unlock;
end; {...TSpreadSheet.ScrollDraw }
procedure TSpreadSheet.SetAreas(ScrollArea:TRect);
{ Sets the locations of the different areas of the spreadsheet }
var
x1, x2, y1, y2 : Byte;
begin
x1 := ScrollArea.A.X;
y1 := ScrollArea.A.Y;
x2 := Pred(ScrollArea.B.X);
y2 := Pred(ScrollArea.B.Y);
TotalRows := Pred(y2 - Succ(y1));
ColArea.Init(x1 + RowNumberSpace, y1, x2, y1, GetColor(6));
RowArea.Init(x1, Succ(Y1), Pred(x1 + RowNumberSpace), Pred(Pred(y2)),
GetColor(7));
InfoArea.Init(x1, y1, Pred(x1 + RowNumberSpace), y1, GetColor(10));
DisplayArea.Init(x1 + RowNumberSpace, Succ(y1), x2, Pred(Pred(y2)),
GetColor(1));
DataArea.Init (x1, Pred(y2), x2, Pred(y2), GetColor(1));
ContentsArea.Init (x1, y2, x2, y2, GetColor(9));
SetScreenColStart(ScreenBlock^.Start.Col);
SetScreenRowStart(ScreenBlock^.Start.Row);
SetBlankArea;
end; {...TSpreadSheet.SetAreas }
{****************************************************************************}
{ TSpreadSheet.SetAvailableCommands }
{****************************************************************************}
procedure TSpreadSheet.SetAvailableCommands;
{ Enables all commands handled by TSpreadSheet. The commands enabled will
depend on whether the spreadsheet is protected or not. }
begin
if not SheetProtected then
EnableCommands([cmRecalc, cmToggleAutoCalc, cmToggleFormulas, cmEditCell,
cmGoToCell, cmChangeColWidth, cmDeleteColumns, cmInsertColumns,
cmDeleteRows, cmInsertRows, cmFormatCells, cmFormatDefault, cmClear,
cmCopy, cmPaste, cmCut, cmChangeColHeaders, cmDeleteColHeaders,
cmToggleHeaders, cmToggleProtection, cmSetUnlocked, cmSetLocked,
cmSortData, cmPrintSheet])
else
begin
EnableCommands([cmRecalc, cmToggleAutoCalc, cmEditCell,
cmGoToCell, cmClear, cmCopy, cmPaste, cmCut, cmToggleProtection,
cmPrintSheet]);
DisableCommands([cmChangeColHeaders, cmDeleteColHeaders,
cmToggleHeaders, cmToggleFormulas, cmChangeColWidth, cmDeleteColumns,
cmInsertColumns, cmDeleteRows, cmInsertRows, cmFormatCells,
cmFormatDefault, cmSetUnlocked, cmSetLocked, cmSortData])
end;
end;
procedure TSpreadSheet.SetBlankArea;
{ Determines if there is a blank area and its location }
var
C : Integer;
begin
Move(DisplayArea, BlankArea, SizeOf(DisplayArea));
with BlankArea do
begin
with ScreenBlock^ do
C := ColStart^[Stop.Col - Start.Col] + ColWidth(Stop.Col);
if C > DisplayArea.LowerRight.Col then
NoBlankArea := True
else
begin
NoBlankArea := False;
UpperLeft.Col := C;
end; {...if/else }
end; {...with BlankArea }
end; {...TSpreadSheet.SetBlankArea }
procedure TSpreadSheet.SetChanged(IsChanged: Boolean);
{ Changes the Modified state of the spreadsheet }
begin
Modified := IsChanged;
if DisplayEnabled then
DisplayInfo;
end; {...TSpreadSheet.SetChanged }
procedure TSpreadSheet.SetLimit(X, Y: Integer);
{ Sets the limits of the spreadsheet and adjusts the scrollbars accordingly }
var
R : TRect;
begin
Limit.X := X;
Limit.Y := Y;
if HScrollBar <> nil then
with HScrollBar^ do
SetParams (Value, 1, X, Succ(ScreenBlock^.Stop.Col -
ScreenBlock^.Start.Col), 1);
if VScrollBar <> nil then
with VScrollBar^ do
SetParams (Value, 1, Y, TotalRows, 1);
end; {...TSpreadSheet.SetLimit }
procedure TSpreadSheet.SetLocked;
{ Restores the cells to the locked state, preventing the modification of the
cells' contents when the sheet is protected }
begin
if BlockOn then
UnlockedHash.Delete(CurrBlock^.Start, CurrBlock^.Stop)
else
UnlockedHash.Delete(CurrPos, CurrPos);
DisplayCellData;
SetChanged(ModifiedYes);
end; {...TSpreadSheet.SetLocked }
procedure TSpreadSheet.SetNameWithMouse(var Event: TEvent);
{ Checks to see if the mouse was DoubleClicked in the col area, and if so,
it calls the ChangeColNames method }
var
Mouse : TPoint;
RealCurrPosCol : Word;
SelectedCol : Word;
begin
MakeLocal(Event.Where, Mouse);
if ColArea.PointInArea(Mouse.X, Mouse.Y) then
begin
RealCurrPosCol := CurrPos.Col;
SelectedCol := XToCol(Mouse.X);
if SelectedCol = 0 then
Exit
else
CurrPos.Col := SelectedCol;
ChangeColHeaders;
CurrPos.Col := RealCurrPosCol;
ClearEvent(Event);
end; {...if ColArea.PointInArea(Mouse.X, Mouse.Y) }
end; {...TSpreadSheet.SetNameWithMouse }
procedure TSpreadSheet.SetProtection(Enable, Display: Boolean);
{ Protects or unprotects the sheet from unauthorized changes }
begin
if Enable then
SheetProtected := True
else
SheetProtected := False;
SetAvailableCommands;
if Display then
begin
DisplayAllCells;
DisplayCellData;
end; {...if Display }
end; {...TSpreadSheet.SetProtection }
procedure TSpreadSheet.SetScreenColStart(NewCol:Integer);
{ Determines the starting and ending columns when the starting column is known }
begin
ScreenBlock^.Start.Col := NewCol;
FindScreenColStop;
FindScreenColStart;
end; {...TSpreadSheet.SetScreenColStart }
procedure TSpreadSheet.SetScreenColStop(NewCol:Integer);
{ Determines the starting and ending columns when the ending column is known }
begin
ScreenBlock^.Stop.Col := NewCol;
FindScreenColStart;
FindScreenColStop;
end; {...TSpreadSheet.SetScreenColStop }
procedure TSpreadSheet.SetScreenRowStart(NewRow:Integer);
{ Determines the starting and ending rows when the starting row is known }
begin
ScreenBlock^.Start.Row := NewRow;
FindScreenRowStop;
end; {...TSpreadSheet.SetScreenRowStart }
procedure TSpreadSheet.SetScreenRowStop(NewRow:Integer);
{ Determines the starting and ending rows when the ending row is known }
begin
ScreenBlock^.Stop.Row := NewRow;
FindScreenRowStart;
end; {...TSpreadSheet.SetScreenRowStop }
procedure TSpreadSheet.SetState(AState: Word; Enable: Boolean);
{ Changes the state of the spreadsheet and displays or hides the cursor
depending on whether the spreadsheet is activated or deactivated }
begin
if AState = sfActive then
begin
SetProtection(SheetProtected, False);
if Enable then
begin
CurrPos := OldCurrPos;
if ScreenBlock^.CellInBlock(CurrPos) or
(CurrPos.Col = Succ(ScreenBlock^.Stop.Col)) then
DisplayCell(CurrPos);
end {...if Enable }
else
begin
OldCurrPos := CurrPos;
CurrPos.Col := Succ(ScreenBlock^.Stop.Col);
CurrPos.Row := Succ(ScreenBlock^.Stop.Row);
if ScreenBlock^.CellInBlock(OldCurrPos) or
(OldCurrPos.Col = Succ(ScreenBlock^.Stop.Col)) then
DisplayCell(OldCurrPos);
end; {...if/else }
end; {...if AState = sfActive }
TScroller.SetState(AState, Enable);
end; {...TSpreadSheet.SetState }
procedure TSpreadSheet.SetUnlocked;
{ Mark the cell or group of cells as unlocked, allowing the modification of
the cells' contents even when the sheet is protected }
begin
if BlockOn then
UnlockedHash.Add(CurrBlock^.Start, CurrBlock^.Stop)
else
UnlockedHash.Add(CurrPos, CurrPos);
DisplayCellData;
SetChanged(ModifiedYes);
end; {...TSpreadSheet.SetUnlocked }
procedure TSpreadSheet.SortData;
{ Sorts the data in the current block using up to three different keys }
var
Dialog : PDialog;
Block : TBlock; { Block of data that will be sorted }
Pos : CellPos; { Used only to complete parameter list }
F : File;
function SortOrder(CheckBoxItem: Byte): SortTypes;
{ Returns the sort type value corresponding to the checkbox item selected }
begin
if CheckBoxItem = 0 then
SortOrder := Ascending
else
SortOrder := Descending;
end; {...SortOrder }
function KeyColumn(KeyValue: String): Word;
{ Returns the corresponding column for the given string }
var
IndicatorLength: Byte;
Pos : CellPos;
Indicator : String;
Col, FormLen : Word;
begin
Col := 0;
IndicatorLength := Length(GLStringList^.Get(sColumnEntryIndicator)+' ');
Indicator := Copy(KeyValue, 1, IndicatorLength);
if Indicator = (GLStringList^.Get(sColumnEntryIndicator)+' ') then
begin
Indicator := Copy(KeyValue, Succ(IndicatorLength), (Length(KeyValue) -
IndicatorLength));
Col := StringToCol(Indicator, MaxCols);
end; {...if Indicator = (GLStringList^.Get(sColumnEntryIndicator)+' ') }
if Col = 0 then
ColHeadersHash.SearchName(KeyValue, Col);
KeyColumn := Col;
end; {...KeyColumn }
begin
if not BlockOn then
begin
CurrBlock^.Start.Col := 1;
CurrBlock^.Start.Row := 1;
CurrBlock^.Stop := LastPos;
end; {...if not BlockOn }
Move(CurrBlock^, Block, SizeOf(CurrBlock^));
Dialog := PDialog(GLResFile^.Get('SortDialog'));
if Application^.ValidView(Dialog) <> nil then
begin
if Desktop^.ExecView(Dialog) <> cmCancel then
begin
Dialog^.GetData(RSortInfo);
MessageDialog := PDialog(GLResFile^.Get('SortingDialog'));
if Application^.ValidView(MessageDialog) <> nil then
begin
Desktop^.Insert(MessageDialog);
StatusLine^.Update;
with RSortInfo do
begin
SetChanged(ModifiedYes);
SortObject^.Init(@CellHash);
SortObject^.Sort(Block,
KeyColumn(FirstKey), SortOrder(FirstKeyOrder),
KeyColumn(SecondKey), SortOrder(SecondKeyOrder),
KeyColumn(ThirdKey), SortOrder(ThirdKeyOrder));
end; {...with RSortInfo }
Desktop^.Delete(MessageDialog);
Dispose(MessageDialog, Done);
MessageDialog := PDialog(GLResFile^.Get('UpdatingTablesDialog'));
Desktop^.Insert(MessageDialog);
StoreTablesToTempFile;
DoneHashTables;
Pos.Col := 0;
Pos.Row := 0;
LoadTablesFromTempFile(Pos, 0, 0);
Assign(F, GLStringList^.Get(sTempFileName));
Erase(F);
FixOverwrite;
DisplayAllCells;
DisplayCellData;
Desktop^.Delete(MessageDialog);
if MessageDialog <> nil then
Dispose(MessageDialog, Done);
end; {...if Application^.ValidView(MessageDialog) <> nil }
MessageDialog := nil;
end; {...if ExecView(Dialog) <> cmCancel }
Dispose(Dialog, Done);
end; {...if Application^.ValidView(Dialog) <> nil }
end; {...TSpreadSheet.SortData }
function TSpreadSheet.SortObject : PSortObject;
{ Returns a pointer to the sort object to be used }
begin
SortObject := StandardSortObject;
end; {...TSpreadSheet.SortObject }
procedure TSpreadSheet.Store(var S: TStream);
{ Writes the spreadsheet object to a stream }
const
FileHeader : String[Length(OOGridFileHeader)] = OOGridFileHeader;
begin
TScroller.Store(S);
S.Write(FileHeader, SizeOf(FileHeader));
S.Write(EmptyRowsAtTop, SizeOf(EmptyRowsAtTop));
S.Write(EmptyRowsAtBottom, SizeOf(EmptyRowsAtBottom));
S.Write(MaxCols, Sizeof(MaxCols));
S.Write(MaxRows, SizeOf(MaxRows));
S.Write(DefaultColWidth, SizeOf(DefaultColWidth));
S.Write(DefaultDecimalPlaces, SizeOf(DefaultDecimalPlaces));
S.Write(MaxDecimalPlaces, SizeOf(MaxDecimalPlaces));
S.Write(DefaultCurrency, SizeOf(DefaultCurrency));
S.Write(LastPos, SizeOf(LastPos));
StoreHashTables(S);
S.Put(ScreenBlock);
S.Write(CurrPos, SizeOf(CurrPos));
S.Write(BlockOn, SizeOf(BlockOn));
S.Put(CurrBlock);
S.Write(DisplayFormulas, SizeOf(DisplayFormulas));
S.Write(AutoCalc, SizeOf(AutoCalc));
S.Write(DisplayHeaders, SizeOf(DisplayHeaders));
S.Write(SheetProtected, SizeOf(SheetProtected));
SetChanged(ModifiedNo);
end; {...TSpreadSheet.Store }
procedure TSpreadSheet.StoreHashTables(var S: TStream);
{ Stores the hash tables in a stream }
begin
S.Write(CellHash.Items, SizeOf(CellHash.Items));
S.Write(WidthHash.Items, 2);
S.Write(FormatHash.Items, SizeOf(FormatHash.Items));
S.Write(ColHeadersHash.Items, 2);
S.Write(UnlockedHash.Items, SizeOf(UnlockedHash.Items));
CellHash.Store(S);
WidthHash.Store(S);
FormatHash.Store(S);
ColHeadersHash.Store(S);
UnlockedHash.Store(S);
end; {...TSpreadSheet.StoreHashTables }
procedure TSpreadSheet.StoreTablesToTempFile;
{ Stores the hash tables in a temporary file in disk }
var
S : TBufStream;
begin
S.Init(GLStringList^.Get(sTempFileName), stCreate, 1024);
StoreHashTables(S);
S.Done;
end; {...TSpreadSheet.StoreTablesToTempFile }
procedure TSpreadSheet.ToggleAutoCalc;
{ Turns the autocalc mode on and off }
begin
AutoCalc := not AutoCalc;
SetChanged(ModifiedYes);
if AutoCalc then
Recalc(DisplayYes);
end; {...TSpreadSheet.ToggleAutoCalc }
procedure TSpreadSheet.ToggleBlockOn;
{ Turns the block state on }
begin
if not BlockOn then
begin
BlockOn := True;
CurrBlock^.Init(CurrPos);
DisplayInfo;
end {...if not BlockOn }
end; {...TSpreadSheet.ToggleBlockOn }
procedure TSpreadSheet.ToggleDisplayHeaders;
{ Toggles between displaying and not displaying the column names }
begin
DisplayHeaders := not DisplayHeaders;
DisplayCols;
SetChanged(ModifiedYes);
end; {...TSpreadSheet.ToggleDisplayHeaders }
procedure TSpreadSheet.ToggleEnd;
{ Toggles on and off the Go_To_End status (the END key was pressed) }
begin
GoToEnd := Not GoToEnd;
DisplayInfo;
end; {...TSpreadSheet.ToggleEnd }
procedure TSpreadSheet.ToggleFormulaDisplay;
{ Toggles between displaying the cell formulas or their values }
var
OChanged : Boolean;
CP : PCell;
begin
Desktop^.Lock;
DisplayFormulas := not DisplayFormulas;
SetChanged(ModifiedYes);
OChanged := True;
with CellHash do
begin
CP := FirstItem;
while (CP <> nil) and OChanged do
begin
if CP^.ShouldUpdate then
OChanged := OverwriteHash.Change(CP, CP^.Overwritten(CellHash,
FormatHash, WidthHash, LastPos, MaxCols, GetColWidth,
DisplayFormulas));
CP := NextItem;
end; {...while (CP <> nil) and OChanged }
end; {...with CellHash }
DisplayAllCells;
DisplayCellData;
Desktop^.Unlock;
end; {...TSpreadSheet.ToggleFormulaDisplay }
function TSpreadSheet.TrackCursor: Boolean;
{ Checks if the cursor is within the limits of the currently displayed
screen block. If not, it adjust the screen block to include
the position of the cursor. }
begin
TrackCursor := False;
if CurrPos.Col < ScreenBlock^.Start.Col then
begin
SetScreenColStart(CurrPos.Col);
TrackCursor := True;
end {...if CurrPos.Col < ScreenBlock^.Start.Col }
else if CurrPos.Col > ScreenBlock^.Stop.Col then
begin
SetScreenColStop(CurrPos.Col);
TrackCursor := True;
end; {...else if CurrPos.Col > ScreenBlock^.Stop.Col }
if CurrPos.Row < ScreenBlock^.Start.Row then
begin
SetScreenRowStart(CurrPos.Row);
TrackCursor := True;
end {...if CurrPos.Row < ScreenBlock^.Start.Row }
else if CurrPos.Row > ScreenBlock^.Stop.Row then
begin
SetScreenRowStop(CurrPos.Row);
TrackCursor := True;
end; {...else if CurrPos.Row > ScreenBlock^.Stop.Row }
end; {...TSpreadSheet.TrackCursor }
procedure TSpreadSheet.UpdateScreenBlockDisplay;
{ Displays the screen and changes the scrollbars' values whenever the
screen block was changed }
begin
ExtendCurrBlock(RedrawNo);
HScrollBar^.Value := ScreenBlock^.Start.Col;
HScrollBar^.Drawview;
VScrollBar^.Value := ScreenBlock^.Start.Row;
VScrollBar^.Drawview;
DrawView;
end; {...TSpreadSheet.UpdateScreenBlockDisplay }
function TSpreadSheet.WidthHashStart:BucketRange;
{ Returns the number of initial buckets of the Width hash table }
begin
WidthHashStart := 10;
end; {...TSpreadSheet.WidthHashStart }
function TSpreadSheet.XToCol(X: Byte): Integer;
{ Returns the spreadsheet column a particular screen column position is in }
var
ColScrPos : Byte;
Counter : Integer;
Col : Word;
begin
Col := 0;
with ScreenBlock^ do
begin
for Counter := Start.Col to Min(Succ(Stop.Col), MaxCols) do
begin
ColScrPos := ColToX(Counter);
if (X < (ColScrPos + ColWidth(Counter))) and (X >= ColScrPos) then
Col := Counter;
end; {...for Counter }
if (Col = 0) and (Stop.Col = MaxCols) then
XToCol := MaxCols
else
XToCol := Col;
end; {...with ScreenBlock^ }
end; {...TSpreadSheet.XToCol }
function TSpreadSheet.YToRow(Y: Byte): Integer;
{ Returns the spreadsheet row a particular screen row position is in }
begin
YToRow := ((Y - DisplayArea.UpperLeft.Row) + ScreenBlock^.Start.Row);
end; {...TSpreadSheet.YToRow }
procedure TSpreadSheet.DoneHashTables;
{ Disposes all the hash tables }
var
Block : TBlock;
Deleted : Boolean;
begin
Block.Init(LastPos);
Block.Start.Col := 1;
Block.Start.Row := 1;
DeleteBlock(Block, Deleted);
CellHash.Done;
WidthHash.Done;
FormatHash.Done;
OverWriteHash.Done;
ColHeadersHash.Done;
UnlockedHash.Done;
end; {...TSpreadSheet.DoneHashTables }
destructor TSpreadSheet.Done;
{ Disposes the spreadsheet }
begin
if ColStart <> nil then
FreeMem(ColStart, MaxScreenCols);
if ScreenBlock <> nil then
Dispose(ScreenBlock, Done);
if CurrBlock <> nil then
Dispose(CurrBlock, Done);
DoneHashTables;
TScroller.Done;
end; {...TSpreadSheet.Done }
begin
ClipBoard.BlockToCopy := nil;
InitClipBoard;
with PrinterConfigRec do
begin
PrinterCondensedOnCode := DefaultPrinterCondensedOnCode;
PrinterCondensedOffCode := DefaultPrinterCondensedOffCode;
PrinterUnderlineOnCode := DefaultPrinterUnderlineOnCode;
PrinterUnderlineOffCode := DefaultPrinterUnderlineOffCode;
PrinterBoldOnCode := DefaultPrinterBoldOnCode;
PrinterBoldOffCode := DefaultPrinterBoldOffCode;
end; {...with PrinterConfigRec }
with RPrint do
begin
PrintTo := 0;
PrintSize := 0;
PrintRows := 0;
PrintColumns := 0;
TopMargin := DefaultTopMargin;
BottomMargin := DefaultBottomMargin;
LeftMargin := DefaultLeftMargin;
RightMargin := DefaultRightMargin;
Other := 0;
PageRows := DefaultPageRows;
NormalCols := DefaultNormalCols;
CondensedCols := DefaultCondensedCols;
end; {...with RPrint }
end. {...GLTSheet unit }